Tcl Source Code

Changes On Branch cplusplus
Login

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

Changes In Branch cplusplus Excluding Merge-Ins

This is equivalent to a diff from f5bc93143d to cfcbd55aba

2020-02-28
12:06
Implement TIP #557: C++ support for Tcl check-in: c4a27f443c user: jan.nijtmans tags: core-8-branch
2020-02-26
16:56
merge core-8-branch check-in: e92d3a4952 user: dkf tags: tip-558
14:05
Merge 8.6 check-in: 0346bb5441 user: jan.nijtmans tags: core-8-branch
10:58
Merge 8.7 Closed-Leaf check-in: cfcbd55aba user: jan.nijtmans tags: cplusplus
08:32
merge core-8-branch check-in: 7859c7efe0 user: dkf tags: tip-567
08:14
Merge 8.7 check-in: 4dc9a5cea0 user: jan.nijtmans tags: trunk
08:04
Merge 8.6 check-in: f5bc93143d user: jan.nijtmans tags: core-8-branch
07:58
Make tclWinDde.c compilable with C++ compiler. dde -> 1.4.3 Make tclWinReg.c compilable with C++ com... check-in: cc5c355ced user: jan.nijtmans tags: core-8-6-branch
2020-02-24
12:18
Merge 8.6 check-in: 1d3f5159be user: jan.nijtmans tags: core-8-branch
2020-02-13
22:06
Merge 8.7 check-in: c59e305ca6 user: jan.nijtmans tags: cplusplus

Changes to .travis.yml.

34
35
36
37
38
39
40








41
42
43
44
45
46
47
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55







+
+
+
+
+
+
+
+







    - name: "Linux/GCC/Debug"
      os: linux
      dist: bionic
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols"
# C++ build.
    - name: "Linux/G++/Shared"
      os: linux
      dist: bionic
      compiler: g++
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register"
# Older versions of GCC...
    - name: "Linux/GCC 7/Shared"
      os: linux
      dist: bionic
      compiler: gcc-7
      addons:
        apt:
318
319
320
321
322
323
324









325
326
327
328
329
330
331
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348







+
+
+
+
+
+
+
+
+







    - name: "Windows/GCC/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++ --enable-64bit"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --disable-shared"
      before_install: *makepreinst
353
354
355
356
357
358
359









360
361
362
363
364
365
366
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392







+
+
+
+
+
+
+
+
+







    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++-x86/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC-x86/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--disable-shared"
      before_install: *makepreinst

Changes to compat/zlib/contrib/minizip/crypt.h.

39
40
41
42
43
44
45

46
47
48
49
50
51
52
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53







+







 * Return the next byte in the pseudo-random sequence
 */
static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab)
{
    unsigned temp;  /* POTENTIAL BUG:  temp*(temp^1) may overflow in an
                     * unpredictable manner on 16-bit systems; not a problem
                     * with any known compiler so far, though */
    (void)pcrc_32_tab;

    temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2;
    return (int)(((temp * (temp ^ 1)) >> 8) & 0xff);
}

/***********************************************************************
 * Update the encryption keys with the next byte of plain text

Changes to generic/tcl.h.

357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
357
358
359
360
361
362
363

364
365
366
367
368
369
370
371







-
+







 *
 * Note on converting between Tcl_WideInt and strings. This implementation (in
 * tclObj.c) depends on the function
 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(_WIN32)
#   if defined(_MSC_VER) || defined(_WIN32)
#      define TCL_WIDE_INT_TYPE __int64
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#   elif defined(__GNUC__)
#      define TCL_Z_MODIFIER	"z"

Changes to generic/tclAssembly.c.

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
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







-
+









-
+







 *	include whatever the code does.
 *
 *-----------------------------------------------------------------------------
 */

int
Tcl_AssembleObjCmd(
    ClientData dummy,		/* Not used. */
    ClientData clientData,		/* clientData */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * Boilerplate - make sure that there is an NRE trampoline on the C stack
     * because there needs to be one in place to execute bytecode.
     */

    return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
    return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, clientData, objc, objv);
}

int
TclNRAssembleObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */

Changes to generic/tclBasic.c.

102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+







typedef struct {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    int length;			/* Length of the above error message. */
    ClientData clientData;	/* Ignored */
    ClientData clientData;		/* Not used. */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock);

/*
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
490


491
492
493
494


495
496
497
498
499
500
501
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
490
491
492


493
494
495
496
497
498
499
500
501







-
+



-
-
-
-
+
+
+
+


-
-
+
+


-
+

-
-
+
+








-
-
+
+


-
+


-
-
+
+


-
-
+
+







 * Math functions. All are safe.
 */

typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that evaluates the function */
    ClientData clientData;	/* Client data for the function */
    double (*fn)(double x);	/* Real function pointer */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",	ExprAbsFunc,	NULL			},
    { "acos",	ExprUnaryFunc,	(ClientData) acos	},
    { "asin",	ExprUnaryFunc,	(ClientData) asin	},
    { "atan",	ExprUnaryFunc,	(ClientData) atan	},
    { "atan2",	ExprBinaryFunc,	(ClientData) atan2	},
    { "acos",	ExprUnaryFunc,	acos			},
    { "asin",	ExprUnaryFunc,	asin			},
    { "atan",	ExprUnaryFunc,	atan			},
    { "atan2",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) atan2},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	(ClientData) cos	},
    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
    { "cos",	ExprUnaryFunc,	cos				},
    { "cosh",	ExprUnaryFunc,	cosh			},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "exp",	ExprUnaryFunc,	exp				},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "hypot",	ExprBinaryFunc,	(ClientData) hypot	},
    { "fmod",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) fmod},
    { "hypot",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) hypot},
    { "int",	ExprIntFunc,	NULL			},
    { "isfinite", ExprIsFiniteFunc, NULL        	},
    { "isinf",	ExprIsInfinityFunc, NULL        	},
    { "isnan",	ExprIsNaNFunc,	NULL            	},
    { "isnormal", ExprIsNormalFunc, NULL        	},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "issubnormal", ExprIsSubnormalFunc, NULL,         },
    { "isunordered", ExprIsUnorderedFunc, NULL,         },
    { "log",	ExprUnaryFunc,	(ClientData) log	},
    { "log10",	ExprUnaryFunc,	(ClientData) log10	},
    { "log",	ExprUnaryFunc,	log				},
    { "log10",	ExprUnaryFunc,	log10			},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	(ClientData) pow	},
    { "pow",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) pow},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	(ClientData) sin	},
    { "sinh",	ExprUnaryFunc,	(ClientData) sinh	},
    { "sin",	ExprUnaryFunc,	sin				},
    { "sinh",	ExprUnaryFunc,	sinh			},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	(ClientData) tan	},
    { "tanh",	ExprUnaryFunc,	(ClientData) tanh	},
    { "tan",	ExprUnaryFunc,	tan				},
    { "tanh",	ExprUnaryFunc,	tanh			},
    { "wide",	ExprWideFunc,	NULL			},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
 */
696
697
698
699
700
701
702
703

704
705
706
707
708
709
710
696
697
698
699
700
701
702

703
704
705
706
707
708
709
710







-
+








    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = ckalloc(sizeof(Interp));
    iPtr = (Interp *)ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

#ifdef TCL_NO_DEPRECATED
    iPtr->result = &tclEmptyString;
#else
    iPtr->result = iPtr->resultSpace;
#endif
727
728
729
730
731
732
733
734
735
736
737




738
739
740
741
742
743
744
727
728
729
730
731
732
733




734
735
736
737
738
739
740
741
742
743
744







-
-
-
-
+
+
+
+








    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
     * structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
    iPtr->linePBodyPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
    iPtr->scriptCLLocPtr = NULL;

    iPtr->activeVarTracePtr = NULL;
833
834
835
836
837
838
839
840

841
842
843
844
845
846
847
833
834
835
836
837
838
839

840
841
842
843
844
845
846
847







-
+








    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = ckalloc(sizeof(CallFrame));
    framePtr = (CallFrame *)ckalloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;
863
864
865
866
867
868
869
870

871
872
873
874
875
876
877
863
864
865
866
867
868
869

870
871
872
873
874
875
876
877







-
+








    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = ckalloc(sizeof(CancelInfo));
    cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;

933
934
935
936
937
938
939
940

941
942
943
944
945
946
947
933
934
935
936
937
938
939

940
941
942
943
944
945
946
947







-
+








    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
962
963
964
965
966
967
968

969
970
971
972
973
974
975
976







-
+







		&& (cmdInfoPtr->nreProc == NULL)) {
	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
	}

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = ckalloc(sizeof(Command));
	    cmdPtr = (Command *)ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
1076
1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105
1106
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106







-
+















-
+







    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
	Tcl_CreateObjCommand(interp, mathFuncName,
		builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
		builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL);
	Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
    }

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = ckalloc(sizeof(TclOpCmdClientData));
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
	occdPtr->expected = opcmdInfoPtr->expected;
	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
1205
1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1205
1206
1207
1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1219







-
+







    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = clientData;
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    ckfree(occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
1256
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1256
1257
1258
1259
1260
1261
1262

1263
1264
1265
1266
1267
1268
1269
1270







-
+







}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    void *procPtr = cmdPtr->objProc;
    Tcl_ObjCmdProc *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
1328
1329
1330
1331
1332
1333
1334
1335

1336
1337
1338
1339
1340
1341
1342
1328
1329
1330
1331
1332
1333
1334

1335
1336
1337
1338
1339
1340
1341
1342







-
+







                    || Tcl_HideCommand(interp, "___tmp",
                            TclGetString(hideName)) != TCL_OK) {
                Tcl_Panic("problem making '%s %s' safe: %s",
                        unsafePtr->ensembleNsName, unsafePtr->commandName,
                        Tcl_GetString(Tcl_GetObjResult(interp)));
            }
            Tcl_CreateObjCommand(interp, TclGetString(cmdName),
                    BadEnsembleSubcommand, (ClientData) unsafePtr, NULL);
                    BadEnsembleSubcommand, (void *)unsafePtr, NULL);
            TclDecrRefCount(cmdName);
            TclDecrRefCount(hideName);
        } else {
            /*
             * Hide an ensemble main command (for compatibility).
             */

1373
1374
1375
1376
1377
1378
1379
1380



1381
1382
1383
1384
1385
1386
1387
1373
1374
1375
1376
1377
1378
1379

1380
1381
1382
1383
1384
1385
1386
1387
1388
1389







-
+
+
+







static int
BadEnsembleSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const UnsafeEnsembleInfo *infoPtr = clientData;
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}
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
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







-
+


-
+






-
+







    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
				 * to be deleted. */
    ClientData clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = ckalloc(sizeof(AssocData));
    AssocData *dPtr = (AssocData *)ckalloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
	iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}
1470
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480
1481
1482
1483
1484
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481
1482
1483
1484
1485
1486







-
+








    hTablePtr = iPtr->assocData;
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = Tcl_GetHashValue(hPtr);
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    ckfree(dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524

1525
1526

1527
1528
1529
1530
1531
1532
1533
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525

1526
1527

1528
1529
1530
1531
1532
1533
1534
1535







-
+




-
+

-
+







{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = ckalloc(sizeof(Tcl_HashTable));
	iPtr->assocData = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
	dPtr = Tcl_GetHashValue(hPtr);
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    } else {
	dPtr = ckalloc(sizeof(AssocData));
	dPtr = (AssocData *)ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}

1560
1561
1562
1563
1564
1565
1566
1567

1568
1569
1570
1571
1572
1573
1574
1562
1563
1564
1565
1566
1567
1568

1569
1570
1571
1572
1573
1574
1575
1576







-
+







    if (iPtr->assocData == NULL) {
	return;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    ckfree(dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1621







-
+







    if (iPtr->assocData == NULL) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return NULL;
    }
    dPtr = Tcl_GetHashValue(hPtr);
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    if (procPtr != NULL) {
	*procPtr = dPtr->proc;
    }
    return dPtr->clientData;
}

/*
1756
1757
1758
1759
1760
1761
1762
1763

1764
1765
1766
1767
1768
1769
1770
1758
1759
1760
1761
1762
1763
1764

1765
1766
1767
1768
1769
1770
1771
1772







-
+







     * TIP #285, Script cancellation support. Delete this interp from the
     * global hash table of CancelInfo structs.
     */

    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
    if (hPtr != NULL) {
	CancelInfo *cancelInfo = Tcl_GetHashValue(hPtr);
	CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);

	if (cancelInfo != NULL) {
	    if (cancelInfo->result != NULL) {
		ckfree(cancelInfo->result);
	    }
	    ckfree(cancelInfo);
	}
1814
1815
1816
1817
1818
1819
1820
1821

1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840

1841
1842
1843
1844
1845
1846
1847
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841

1842
1843
1844
1845
1846
1847
1848
1849







-
+


















-
+







	 * to create any new hidden or non-hidden commands.
	 * Tcl_DeleteCommandFromToken will remove the entry from the
	 * hiddenCmdTablePtr.
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, Tcl_GetHashValue(hPtr));
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	ckfree(hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	iPtr->assocData = NULL;
	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
		hPtr != NULL;
		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
	    dPtr = Tcl_GetHashValue(hPtr);
	    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    ckfree(dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
1930
1931
1932
1933
1934
1935
1936
1937

1938
1939
1940
1941
1942
1943
1944
1932
1933
1934
1935
1936
1937
1938

1939
1940
1941
1942
1943
1944
1945
1946







-
+







     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
     * contents.
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
	CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr);
	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);

	procPtr->iPtr = NULL;
	if (cfPtr) {
	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(cfPtr->data.eval.path);
	    }
1954
1955
1956
1957
1958
1959
1960
1961

1962
1963
1964
1965
1966
1967
1968
1956
1957
1958
1959
1960
1961
1962

1963
1964
1965
1966
1967
1968
1969
1970







-
+







    /*
     * See also tclCompile.c, TclCleanupByteCode
     */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = Tcl_GetHashValue(hPtr);
	ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr);

	if (eclPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(eclPtr->path);
	}
	for (i=0; i< eclPtr->nuloc; i++) {
	    ckfree(eclPtr->loc[i].line);
	}
2118
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131
2132
2120
2121
2122
2123
2124
2125
2126

2127
2128
2129
2130
2131
2132
2133
2134







-
+








    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = ckalloc(sizeof(Tcl_HashTable));
	hiddenCmdTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
2258
2259
2260
2261
2262
2263
2264
2265

2266
2267
2268
2269
2270
2271
2272
2260
2261
2262
2263
2264
2265
2266

2267
2268
2269
2270
2271
2272
2273
2274







-
+







    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown hidden command \"%s\"", hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
                hiddenCmdToken, NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

2454
2455
2456
2457
2458
2459
2460
2461

2462
2463
2464
2465
2466
2467
2468
2456
2457
2458
2459
2460
2461
2462

2463
2464
2465
2466
2467
2468
2469
2470







-
+







	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = Tcl_GetHashValue(hPtr);
	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve any existing import links so we can restore
	 * them down below. That way, you can redefine a command and its
	 * import status will remain intact.
	 */

2509
2510
2511
2512
2513
2514
2515
2516

2517
2518
2519
2520
2521
2522
2523
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2525







-
+







	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    cmdPtr = (Command *)ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
2536
2537
2538
2539
2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
2538
2539
2540
2541
2542
2543
2544

2545
2546
2547
2548
2549
2550
2551
2552







-
+







     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;
	    dataPtr = refCmdPtr->objClientData;
	    dataPtr = (ImportedCmdData *)refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent
2673
2674
2675
2676
2677
2678
2679
2680

2681
2682
2683
2684
2685
2686
2687
2675
2676
2677
2678
2679
2680
2681

2682
2683
2684
2685
2686
2687
2688
2689







-
+







	    break;
	}

	/*
         * An existing command conflicts. Try to delete it...
         */

	cmdPtr = Tcl_GetHashValue(hPtr);
	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	/*
	 * [***] This is wrong.  See Tcl Bug a16752c252.
	 * However, this buggy behavior is kept under particular circumstances
	 * to accommodate deployed binaries of the "tclcompiler" program
	 * <http://sourceforge.net/projects/tclpro/> that crash if the bug is
	 * fixed.
2754
2755
2756
2757
2758
2759
2760
2761

2762
2763
2764
2765
2766
2767
2768
2756
2757
2758
2759
2760
2761
2762

2763
2764
2765
2766
2767
2768
2769
2770







-
+







	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = ckalloc(sizeof(Command));
    cmdPtr = (Command *)ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
2782
2783
2784
2785
2786
2787
2788
2789

2790
2791
2792
2793
2794
2795
2796
2784
2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2798







-
+







     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;

	    dataPtr = refCmdPtr->objClientData;
	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent
2827
2828
2829
2830
2831
2832
2833
2834

2835
2836

2837
2838
2839
2840
2841
2842
2843
2829
2830
2831
2832
2833
2834
2835

2836
2837

2838
2839
2840
2841
2842
2843
2844
2845







-
+

-
+







int
TclInvokeStringCommand(
    ClientData clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr = clientData;
    Command *cmdPtr = (Command *)clientData;
    int i, result;
    const char **argv =
    const char **argv = (const char **)
	    TclStackAlloc(interp, (objc + 1) * sizeof(char *));

    for (i = 0; i < objc; i++) {
	argv[i] = TclGetString(objv[i]);
    }
    argv[objc] = 0;

2875
2876
2877
2878
2879
2880
2881
2882

2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
2877
2878
2879
2880
2881
2882
2883

2884
2885
2886

2887
2888
2889
2890
2891
2892
2893
2894







-
+


-
+







int
TclInvokeObjectCommand(
    ClientData clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)	/* Argument strings. */
{
    Command *cmdPtr = clientData;
    Command *cmdPtr = ( Command *) clientData;
    Tcl_Obj *objPtr;
    int i, length, result;
    Tcl_Obj **objv =
    Tcl_Obj **objv = (Tcl_Obj **)
	    TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *)));

    for (i = 0; i < argc; i++) {
	length = strlen(argv[i]);
	TclNewStringObj(objPtr, argv[i], length);
	Tcl_IncrRefCount(objPtr);
	objv[i] = objPtr;
3313
3314
3315
3316
3317
3318
3319
3320

3321
3322
3323
3324
3325

3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337

3338
3339
3340
3341
3342
3343
3344
3315
3316
3317
3318
3319
3320
3321

3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339

3340
3341
3342
3343
3344
3345
3346
3347







-
+





+











-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetCommandName(
    Tcl_Interp *interp,		/* Interpreter containing the command. */
    Tcl_Interp *dummy,		/* Not used. */
    Tcl_Command command)	/* Token for command returned by a previous
				 * call to Tcl_CreateCommand. The command must
				 * not have been deleted. */
{
    Command *cmdPtr = (Command *) command;
    (void)dummy;

    if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
	/*
	 * This should only happen if command was "created" after the
	 * interpreter began to be deleted, so there isn't really any command.
	 * Just return an empty string.
	 */

	return "";
    }

    return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
    return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFullName --
 *
3380
3381
3382
3383
3384
3385
3386
3387

3388
3389
3390
3391
3392
3393
3394
3383
3384
3385
3386
3387
3388
3389

3390
3391
3392
3393
3394
3395
3396
3397







-
+







	if (cmdPtr->nsPtr != NULL) {
	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
		Tcl_AppendToObj(objPtr, "::", 2);
	    }
	}
	if (cmdPtr->hPtr != NULL) {
	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
	    name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
	    Tcl_AppendToObj(objPtr, name, -1);
	}
    }
}

/*
 *----------------------------------------------------------------------
3761
3762
3763
3764
3765
3766
3767
3768

3769
3770
3771

3772

3773
3774
3775
3776
3777
3778
3779
3764
3765
3766
3767
3768
3769
3770

3771
3772
3773

3774
3775
3776
3777
3778
3779
3780
3781
3782
3783







-
+


-
+

+







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

static int
CancelEvalProc(
    ClientData clientData,	/* Interp to cancel the script in progress. */
    Tcl_Interp *interp,		/* Ignored */
    Tcl_Interp *dummy,		/* Not used. */
    int code)			/* Current return code from command. */
{
    CancelInfo *cancelInfo = clientData;
    CancelInfo *cancelInfo = (CancelInfo *)clientData;
    Interp *iPtr;
    (void)dummy;

    if (cancelInfo != NULL) {
	Tcl_MutexLock(&cancelLock);
	iPtr = (Interp *) cancelInfo->interp;

	if (iPtr != NULL) {
	    /*
3884
3885
3886
3887
3888
3889
3890
3891

3892
3893
3894
3895

3896
3897
3898
3899
3900
3901
3902
3888
3889
3890
3891
3892
3893
3894

3895
3896
3897
3898

3899
3900
3901
3902
3903
3904
3905
3906







-
+



-
+







				 * argument. */
    Tcl_MathProc *proc,		/* C function that implements the math
				 * function. */
    ClientData clientData)	/* Additional value to pass to the
				 * function. */
{
    Tcl_DString bigName;
    OldMathFuncData *data = ckalloc(sizeof(OldMathFuncData));
    OldMathFuncData *data = (OldMathFuncData *)ckalloc(sizeof(OldMathFuncData));

    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = ckalloc(numArgs * sizeof(Tcl_ValueType));
    data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    TclDStringAppendLiteral(&bigName, "::tcl::mathfunc::");
    Tcl_DStringAppend(&bigName, name, -1);

3926
3927
3928
3929
3930
3931
3932
3933

3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952

3953
3954
3955
3956
3957
3958
3959
3930
3931
3932
3933
3934
3935
3936

3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955

3956
3957
3958
3959
3960
3961
3962
3963







-
+


















-
+







    ClientData clientData,	/* Pointer to OldMathFuncData describing the
				 * function being called */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    Tcl_Obj *valuePtr;
    OldMathFuncData *dataPtr = clientData;
    OldMathFuncData *dataPtr = (OldMathFuncData *)clientData;
    Tcl_Value funcResult, *args;
    int result;
    int j, k;
    double d;

    /*
     * Check argument count.
     */

    if (objc != dataPtr->numArgs + 1) {
	MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
	return TCL_ERROR;
    }

    /*
     * Convert arguments from Tcl_Obj's to Tcl_Value's.
     */

    args = ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
    args = (Tcl_Value *)ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
    for (j = 1, k = 0; j < objc; ++j, ++k) {
	/* TODO: Convert to TclGetNumberFromObj? */
	valuePtr = objv[j];
	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
	if (result != TCL_OK) {
	    const Tcl_ObjIntRep *irPtr
4068
4069
4070
4071
4072
4073
4074
4075

4076
4077
4078
4079
4080
4081
4082
4072
4073
4074
4075
4076
4077
4078

4079
4080
4081
4082
4083
4084
4085
4086







-
+







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

static void
OldMathFuncDeleteProc(
    ClientData clientData)
{
    OldMathFuncData *dataPtr = clientData;
    OldMathFuncData *dataPtr = (OldMathFuncData *)clientData;

    ckfree(dataPtr->argTypes);
    ckfree(dataPtr);
}

/*
 *----------------------------------------------------------------------
4141
4142
4143
4144
4145
4146
4147
4148

4149
4150
4151
4152
4153
4154
4155
4145
4146
4147
4148
4149
4150
4151

4152
4153
4154
4155
4156
4157
4158
4159







-
+








    /*
     * Retrieve function info for user defined functions; return dummy
     * information for builtins.
     */

    if (cmdPtr->objProc == &OldMathFuncProc) {
	OldMathFuncData *dataPtr = cmdPtr->clientData;
	OldMathFuncData *dataPtr = (OldMathFuncData *)cmdPtr->clientData;

	*procPtr = dataPtr->proc;
	*numArgsPtr = dataPtr->numArgs;
	*argTypesPtr = dataPtr->argTypes;
	*clientDataPtr = dataPtr->clientData;
    } else {
	*procPtr = NULL;
4478
4479
4480
4481
4482
4483
4484
4485

4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497

4498
4499
4500
4501
4502
4503
4504
4482
4483
4484
4485
4486
4487
4488

4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500

4501
4502
4503
4504
4505
4506
4507
4508







-
+











-
+







    if (hPtr == NULL) {
	/*
	 * No CancelInfo record for this interpreter.
	 */

	goto done;
    }
    cancelInfo = Tcl_GetHashValue(hPtr);
    cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);

    /*
     * Populate information needed by the interpreter thread to fulfill the
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack
     * for the interp is completely unwound.
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
	cancelInfo->result = (char *)ckrealloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    }
    cancelInfo->clientData = clientData;
4610
4611
4612
4613
4614
4615
4616
4617

4618
4619
4620

4621
4622
4623

4624
4625
4626
4627
4628
4629
4630
4614
4615
4616
4617
4618
4619
4620

4621
4622
4623

4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635







-
+


-
+



+








static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Command *cmdPtr = NULL, *preCmdPtr = data[0];
    Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = NULL;
    int enterTracesDone = 0;
    (void)result;

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
     */

    if (!(flags & TCL_EVAL_NOERR)) {
4770
4771
4772
4773
4774
4775
4776
4777

4778
4779
4780

4781

4782
4783
4784
4785
4786
4787
4788
4775
4776
4777
4778
4779
4780
4781

4782
4783
4784

4785
4786
4787
4788
4789
4790
4791
4792
4793
4794







-
+


-
+

+








static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_ObjCmdProc *objProc = data[0];
    Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0];
    ClientData clientData = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;
    (void)result;

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	const char *a[10];
	int i = 0;

	while (i < 10) {
4958
4959
4960
4961
4962
4963
4964
4965

4966
4967
4968
4969
4970
4971
4972
4964
4965
4966
4967
4968
4969
4970

4971
4972
4973
4974
4975
4976
4977
4978







-
+








static int
TEOV_RestoreVarFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ((Interp *) interp)->varFramePtr = data[0];
    ((Interp *) interp)->varFramePtr = (CallFrame *)data[0];
    return result;
}

static int
TEOV_Exception(
    ClientData data[],
    Tcl_Interp *interp,
5002
5003
5004
5005
5006
5007
5008
5009

5010
5011
5012
5013
5014
5015
5016
5008
5009
5010
5011
5012
5013
5014

5015
5016
5017
5018
5019
5020
5021
5022







-
+







    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    int cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];
    Tcl_Obj **objv = (Tcl_Obj **)data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */
5064
5065
5066
5067
5068
5069
5070
5071

5072
5073
5074
5075
5076
5077
5078
5070
5071
5072
5073
5074
5075
5076

5077
5078
5079
5080
5081
5082
5083
5084







-
+







     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
    newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);

    /*
     * Copy command prefix from unknown handler and add on the real command's
     * full argument list. Note that we only use memcpy() once because we have
     * to increment the reference count of all the handler arguments anyway.
     */

5125
5126
5127
5128
5129
5130
5131
5132
5133


5134
5135
5136
5137
5138
5139
5140
5131
5132
5133
5134
5135
5136
5137


5138
5139
5140
5141
5142
5143
5144
5145
5146







-
-
+
+







TEOV_NotFoundCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = data[1];
    Namespace *savedNsPtr = data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[1];
    Namespace *savedNsPtr = (Namespace *)data[2];

    int i;

    if (savedNsPtr) {
	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }

5206
5207
5208
5209
5210
5211
5212
5213
5214
5215



5216
5217
5218
5219
5220
5221
5222
5212
5213
5214
5215
5216
5217
5218



5219
5220
5221
5222
5223
5224
5225
5226
5227
5228







-
-
-
+
+
+







    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = data[1];
    Command *cmdPtr = data[2];
    Tcl_Obj **objv = data[3];
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    int length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440



5441
5442
5443


5444
5445
5446
5447
5448
5449
5450
5437
5438
5439
5440
5441
5442
5443



5444
5445
5446
5447


5448
5449
5450
5451
5452
5453
5454
5455
5456







-
-
-
+
+
+

-
-
+
+







    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    unsigned int i, objectsUsed = 0;
				/* These variables keep track of how much
				 * state has been allocated while evaluating
				 * the script, so that it can be freed
				 * properly if an error occurs. */
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray =
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)
	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
    int *expandStack = TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = TclStackAlloc(interp, minObjs * sizeof(int));
    int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
				/* TIP #280 Structures for tracking of command
				 * locations. */
    int *clNext = NULL;		/* Pointer for the tracking of invisible
				 * continuation lines. Initialized only if the
				 * caller gave us a table of locations to
				 * track, via scriptCLLocPtr. It always refers
				 * to the table entry holding the location of
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581



5582
5583
5584
5585
5586
5587
5588
5578
5579
5580
5581
5582
5583
5584



5585
5586
5587
5588
5589
5590
5591
5592
5593
5594







-
-
-
+
+
+







	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    if (numWords > minObjs) {
		expand =    ckalloc(numWords * sizeof(int));
		objvSpace = ckalloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = ckalloc(numWords * sizeof(int));
		expand =    (int *)ckalloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)ckalloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *)ckalloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
5660
5661
5662
5663
5664
5665
5666
5667
5668


5669
5670
5671
5672
5673
5674
5675
5666
5667
5668
5669
5670
5671
5672


5673
5674
5675
5676
5677
5678
5679
5680
5681







-
-
+
+







		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = ckalloc(objectsNeeded * sizeof(int));
			    (Tcl_Obj **)ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)ckalloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];
5982
5983
5984
5985
5986
5987
5988
5989

5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000

6001
6002
6003
6004
6005
6006
6007
5988
5989
5990
5991
5992
5993
5994

5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005

6006
6007
6008
6009
6010
6011
6012
6013







-
+










-
+







	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);
	if (isNew) {
	    /*
	     * The word is not on the stack yet, remember the current location
	     * and initialize references.
	     */

	    cfwPtr = ckalloc(sizeof(CFWord));
	    cfwPtr = (CFWord *)ckalloc(sizeof(CFWord));
	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->word = i;
	    cfwPtr->refCount = 1;
	    Tcl_SetHashValue(hPtr, cfwPtr);
	} else {
	    /*
	     * The word is already on the stack, its current location is not
	     * relevant. Just remember the reference to prevent early removal.
	     */

	    cfwPtr = Tcl_GetHashValue(hPtr);
	    cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
	    cfwPtr->refCount++;
	}
    }
}

/*
 *----------------------------------------------------------------------
6036
6037
6038
6039
6040
6041
6042
6043

6044
6045
6046
6047
6048
6049
6050
6042
6043
6044
6045
6046
6047
6048

6049
6050
6051
6052
6053
6054
6055
6056







-
+







	CFWord *cfwPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);

	if (!hPtr) {
	    continue;
	}
	cfwPtr = Tcl_GetHashValue(hPtr);
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

	ckfree(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
6088
6089
6090
6091
6092
6093
6094
6095

6096
6097
6098
6099
6100
6101
6102
6094
6095
6096
6097
6098
6099
6100

6101
6102
6103
6104
6105
6106
6107
6108







-
+







    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hePtr =
	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);

    if (!hePtr) {
	return;
    }
    eclPtr = Tcl_GetHashValue(hePtr);
    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
    ePtr = &eclPtr->loc[cmd];

    /*
     * ePtr->nline is the number of words originally parsed.
     *
     * objc is the number of elements getting invoked.
     *
6121
6122
6123
6124
6125
6126
6127
6128

6129
6130
6131


6132
6133
6134
6135
6136
6137
6138
6139
6140

6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155

6156
6157
6158
6159
6160
6161
6162
6127
6128
6129
6130
6131
6132
6133

6134
6135


6136
6137
6138
6139
6140
6141
6142
6143
6144
6145

6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160

6161
6162
6163
6164
6165
6166
6167
6168







-
+

-
-
+
+








-
+














-
+







     *
     * Item (2) is why we can use objv to get the literals, and do not
     * have to save them at compile time.
     */

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isnew;
	    int isNew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isnew);
	    CFWordBC *cfwPtr = ckalloc(sizeof(CFWordBC));
		objv[word], &isNew);
	    CFWordBC *cfwPtr = (CFWordBC *)ckalloc(sizeof(CFWordBC));

	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;

	    if (isnew) {
	    if (isNew) {
		/*
		 * The word is not on the stack yet, remember the current
		 * location and initialize references.
		 */

		cfwPtr->prevPtr = NULL;
	    } else {
		/*
		 * The object is already on the stack, however it may have
		 * a different location now (literal sharing may map
		 * multiple location to a single Tcl_Obj*. Save the old
		 * information in the new structure.
		 */

		cfwPtr->prevPtr = Tcl_GetHashValue(hPtr);
		cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
	    }

	    Tcl_SetHashValue(hPtr, cfwPtr);
	}
    } /* for */

    cfPtr->litarg = lastPtr;
6190
6191
6192
6193
6194
6195
6196
6197

6198
6199
6200
6201
6202
6203
6204
6196
6197
6198
6199
6200
6201
6202

6203
6204
6205
6206
6207
6208
6209
6210







-
+







    Interp *iPtr = (Interp *) interp;
    CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;

    while (cfwPtr) {
	CFWordBC *nextPtr = cfwPtr->nextPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
	CFWordBC *xPtr = Tcl_GetHashValue(hPtr);
	CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);

	if (xPtr != cfwPtr) {
	    Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
	}

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
6256
6257
6258
6259
6260
6261
6262
6263

6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277

6278
6279
6280
6281
6282
6283
6284
6262
6263
6264
6265
6266
6267
6268

6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282

6283
6284
6285
6286
6287
6288
6289
6290







-
+













-
+







    /*
     * First look for location information recorded in the argument
     * stack. That is nearest.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
    if (hPtr) {
	CFWord *cfwPtr = Tcl_GetHashValue(hPtr);
	CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	*wordPtr = cfwPtr->word;
	*cfPtrPtr = cfwPtr->framePtr;
	return;
    }

    /*
     * Check if the Tcl_Obj has location information as a bytecode literal, in
     * that stack.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
    if (hPtr) {
	CFWordBC *cfwPtr = Tcl_GetHashValue(hPtr);
	CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);

	framePtr = cfwPtr->framePtr;
	framePtr->data.tebc.pc = (char *) (((ByteCode *)
		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
	*cfPtrPtr = cfwPtr->framePtr;
	*wordPtr = cfwPtr->word;
	return;
6486
6487
6488
6489
6490
6491
6492
6493

6494
6495
6496
6497
6498
6499
6500
6492
6493
6494
6495
6496
6497
6498

6499
6500
6501
6502
6503
6504
6505
6506







-
+







	     * and TclInitCompileEnv), are special-cased to use the proper
	     * line number directly instead of accessing the 'line' array.
	     *
	     * Note that we use (word==INTMIN) to signal that no command frame
	     * should be pushed, as needed by alias and ensemble redirections.
	     */

	    eoFramePtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	    eoFramePtr->nline = 0;
	    eoFramePtr->line = NULL;

	    eoFramePtr->type = TCL_LOCATION_EVAL;
	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
		    1 : iPtr->cmdFramePtr->level + 1);
	    eoFramePtr->framePtr = iPtr->framePtr;
6595
6596
6597
6598
6599
6600
6601
6602
6603


6604
6605
6606
6607
6608
6609
6610
6601
6602
6603
6604
6605
6606
6607


6608
6609
6610
6611
6612
6613
6614
6615
6616







-
-
+
+







static int
TEOEx_ByteCodeCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *savedVarFramePtr = data[0];
    Tcl_Obj *objPtr = data[1];
    CallFrame *savedVarFramePtr = (CallFrame *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];
    int allowExceptions = PTR2INT(data[2]);

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650



6651
6652
6653
6654
6655
6656
6657
6647
6648
6649
6650
6651
6652
6653



6654
6655
6656
6657
6658
6659
6660
6661
6662
6663







-
-
-
+
+
+







static int
TEOEx_ListCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = data[0];
    CmdFrame *eoFramePtr = data[1];
    Tcl_Obj *objPtr = data[2];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];
    CmdFrame *eoFramePtr = (CmdFrame *)data[1];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[2];

    /*
     * Remove the cmdFrame
     */

    if (eoFramePtr) {
	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
7027
7028
7029
7030
7031
7032
7033
7034

7035
7036
7037
7038
7039
7040
7041
7042
7043

7044
7045
7046
7047
7048
7049
7050
7051
7052
7053
7054
7055
7056
7057

7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077

7078
7079
7080
7081


7082
7083
7084
7085
7086
7087
7088
7033
7034
7035
7036
7037
7038
7039

7040
7041
7042
7043
7044
7045
7046
7047
7048
7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063

7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083

7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097







-
+









+













-
+



















-
+




+
+







	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }
    return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
}

int
TclNRInvoke(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
    const char *cmdName;	/* Name of the command from objv[0]. */
    Tcl_HashEntry *hPtr = NULL;
    Command *cmdPtr;
    (void)dummy;

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid hidden command name \"%s\"", cmdName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
	return TCL_ERROR;
    }
    cmdPtr = Tcl_GetHashValue(hPtr);
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

    /*
     * Avoid the exception-handling brain damage when numLevels == 0
     */

    iPtr->numLevels++;
    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);

    /*
     * Normal command resolution of objv[0] isn't going to find cmdPtr.
     * That's the whole point of **hidden** commands.  So tell the Eval core
     * machinery not to even try (and risk finding something wrong).
     */

    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
}

static int
NRPostInvoke(
    ClientData clientData[],
    ClientData dummy[],		/* Not used. */
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *)interp;
    (void)dummy;

    iPtr->numLevels--;
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
7509
7510
7511
7512
7513
7514
7515
7516

7517
7518
7519
7520
7521
7522
7523
7524

7525
7526
7527
7528
7529
7530
7531
7518
7519
7520
7521
7522
7523
7524

7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541







-
+








+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExprCeilFunc(
    ClientData clientData,	/* Ignored */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
7549
7550
7551
7552
7553
7554
7555
7556

7557
7558
7559
7560
7561
7562
7563
7564

7565
7566
7567
7568
7569
7570
7571
7559
7560
7561
7562
7563
7564
7565

7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582







-
+








+







	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d)));
    }
    return TCL_OK;
}

static int
ExprFloorFunc(
    ClientData clientData,	/* Ignored */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
7589
7590
7591
7592
7593
7594
7595
7596

7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607

7608
7609
7610
7611
7612
7613
7614
7600
7601
7602
7603
7604
7605
7606

7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626







-
+











+







	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d)));
    }
    return TCL_OK;
}

static int
ExprIsqrtFunc(
    ClientData clientData,	/* Ignored */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    ClientData ptr;
    int type;
    double d;
    Tcl_WideInt w;
    mp_int big;
    int exact = 0;		/* Flag ==1 if the argument can be represented
				 * in a double as an exact integer. */
    (void)dummy;

    /*
     * Check syntax.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
7695
7696
7697
7698
7699
7700
7701
7702

7703
7704
7705
7706
7707
7708
7709
7710

7711
7712
7713
7714
7715
7716
7717
7707
7708
7709
7710
7711
7712
7713

7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730







-
+








+







    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
	    "domain error: argument not in valid range", NULL);
    return TCL_ERROR;
}

static int
ExprSqrtFunc(
    ClientData clientData,	/* Ignored */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
7863
7864
7865
7866
7867
7868
7869
7870

7871
7872
7873
7874
7875
7876
7877
7878

7879
7880
7881
7882
7883
7884
7885
7876
7877
7878
7879
7880
7881
7882

7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899







-
+








+







    }
    errno = 0;
    return CheckDoubleResult(interp, func(d1, d2));
}

static int
ExprAbsFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    ClientData ptr;
    int type;
    mp_int big;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
7962
7963
7964
7965
7966
7967
7968
7969

7970
7971
7972
7973
7974
7975

7976
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990

7991
7992
7993
7994
7995
7996

7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017

8018
8019
8020
8021
8022
8023
8024
8025

8026
8027
8028
8029
8030
8031
8032
7976
7977
7978
7979
7980
7981
7982

7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004

8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
8032

8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049







-
+






+














-
+






+




















-
+








+







#endif
    }
    return TCL_OK;
}

static int
ExprBoolFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    int value;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}

static int
ExprDoubleFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double dResult;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (TclHasIntRep(objv[1], &tclDoubleType)) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
8066
8067
8068
8069
8070
8071
8072
8073

8074
8075
8076
8077
8078
8079

8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094

8095
8096
8097
8098
8099
8100
8101
8102
8103
8104

8105
8106
8107
8108
8109
8110
8111
8083
8084
8085
8086
8087
8088
8089

8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111

8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130







-
+






+














-
+










+








    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprWideFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Tcl_WideInt wResult;
    (void)dummy;

    if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

/*
 * Common implmentation of max() and min().
 */
static int
ExprMaxMinFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv,	/* Actual parameter vector. */
    int op)			/* Comparison direction */
{
    Tcl_Obj *res;
    double d;
    int type, i;
    ClientData ptr;
    (void)dummy;

    if (objc < 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    res = objv[1];
    for (i = 1; i < objc; i++) {
8127
8128
8129
8130
8131
8132
8133
8134

8135
8136
8137
8138
8139

8140

8141
8142
8143
8144
8145

8146
8147
8148
8149
8150

8151

8152
8153
8154
8155
8156

8157
8158
8159
8160
8161
8162
8163
8164
8165
8166

8167
8168
8169
8170
8171
8172
8173
8146
8147
8148
8149
8150
8151
8152

8153
8154
8155
8156
8157
8158
8159

8160
8161
8162
8163
8164

8165
8166
8167
8168
8169
8170
8171

8172
8173
8174
8175
8176

8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195







-
+





+
-
+




-
+





+
-
+




-
+










+








    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

static int
ExprMaxFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    (void)dummy;
    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
    return ExprMaxMinFunc(NULL, interp, objc, objv, MP_GT);
}

static int
ExprMinFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    (void)dummy;
    return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
    return ExprMaxMinFunc(NULL, interp, objc, objv, MP_LT);
}

static int
ExprRandFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    double dResult;
    long tmp;			/* Algorithm assumes at least 32 bits. Only
				 * long guarantees that. See below. */
    Tcl_Obj *oResult;
    (void)dummy;

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

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
8242
8243
8244
8245
8246
8247
8248
8249

8250
8251
8252
8253
8254
8255
8256
8257

8258
8259
8260
8261
8262
8263
8264
8264
8265
8266
8267
8268
8269
8270

8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287







-
+








+







    TclNewDoubleObj(oResult, dResult);
    Tcl_SetObjResult(interp, oResult);
    return TCL_OK;
}

static int
ExprRoundFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    double d;
    ClientData ptr;
    int type;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8321
8322
8323
8324
8325
8326
8327
8328

8329
8330
8331
8332
8333
8334
8335

8336
8337
8338
8339
8340
8341
8342
8344
8345
8346
8347
8348
8349
8350

8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
8365
8366







-
+







+








    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprSrandFunc(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_WideInt w = 0;			/* Initialized to avoid compiler warning. */
    (void)dummy;

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
8360
8361
8362
8363
8364
8365
8366
8367

8368
8369
8370
8371
8372
8373
8374
8384
8385
8386
8387
8388
8389
8390

8391
8392
8393
8394
8395
8396
8397
8398







-
+








    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function
     * will always succeed.
     */

    return ExprRandFunc(clientData, interp, 1, objv);
    return ExprRandFunc(NULL, interp, 1, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Double Classification Functions --
 *
8510
8511
8512
8513
8514
8515
8516
8517

8518
8519
8520
8521
8522
8523
8524
8525

8526
8527
8528
8529
8530
8531
8532
8534
8535
8536
8537
8538
8539
8540

8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
8551
8552
8553
8554
8555
8556
8557







-
+








+







#error "unknown or unexpected TCL_FPCLASSIFY_MODE"
#endif /* TCL_FPCLASSIFY_MODE */
#endif /* !fpclassify */
}

static int
ExprIsFiniteFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8541
8542
8543
8544
8545
8546
8547
8548

8549
8550
8551
8552
8553
8554
8555
8556

8557
8558
8559
8560
8561
8562
8563
8566
8567
8568
8569
8570
8571
8572

8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589







-
+








+







    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsInfinityFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8571
8572
8573
8574
8575
8576
8577
8578

8579
8580
8581
8582
8583
8584
8585
8586

8587
8588
8589
8590
8591
8592
8593
8597
8598
8599
8600
8601
8602
8603

8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616
8617
8618
8619
8620







-
+








+







    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNaNFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 1;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8601
8602
8603
8604
8605
8606
8607
8608

8609
8610
8611
8612
8613
8614
8615
8616

8617
8618
8619
8620
8621
8622
8623
8628
8629
8630
8631
8632
8633
8634

8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651







-
+








+







    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNormalFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8631
8632
8633
8634
8635
8636
8637
8638

8639
8640
8641
8642
8643
8644
8645
8646

8647
8648
8649
8650
8651
8652
8653
8659
8660
8661
8662
8663
8664
8665

8666
8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681
8682







-
+








+







    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsSubnormalFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;
    (void)dummy;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8661
8662
8663
8664
8665
8666
8667
8668

8669
8670
8671
8672
8673
8674
8675
8676

8677
8678
8679
8680
8681
8682
8683
8690
8691
8692
8693
8694
8695
8696

8697
8698
8699
8700
8701
8702
8703
8704
8705
8706
8707
8708
8709
8710
8711
8712
8713







-
+








+







    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsUnorderedFunc(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;
    (void)dummy;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8702
8703
8704
8705
8706
8707
8708
8709

8710
8711
8712
8713
8714
8715
8716
8717
8718

8719
8720
8721
8722
8723
8724
8725
8732
8733
8734
8735
8736
8737
8738

8739
8740
8741
8742
8743
8744
8745
8746
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756







-
+









+








    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
FloatClassifyObjCmd(
    ClientData ignored,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    Tcl_Obj *objPtr;
    ClientData ptr;
    int type;
    (void)dummy;

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

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
8816
8817
8818
8819
8820
8821
8822



8823
8824
8825
8826
8827
8828
8829
8847
8848
8849
8850
8851
8852
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863







+
+
+







static int
DTraceObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)interp;

    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
	char *a[10];
	int i = 0;

	while (i++ < 10) {
	    a[i-1] = i < objc ? TclGetString(objv[i]) : NULL;
	}
9195
9196
9197
9198
9199
9200
9201
9202

9203
9204
9205
9206
9207

9208
9209
9210
9211
9212
9213
9214
9229
9230
9231
9232
9233
9234
9235

9236
9237
9238
9239
9240
9241
9242
9243
9244
9245
9246
9247
9248
9249







-
+





+







 *	updated so that its data[1] field contains the tailcall list.
 *
 *----------------------------------------------------------------------
 */

int
TclNRTailcallObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?");
	return TCL_ERROR;
    }

    if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
9265
9266
9267
9268
9269
9270
9271
9272

9273
9274
9275
9276
9277
9278
9279
9300
9301
9302
9303
9304
9305
9306

9307
9308
9309
9310
9311
9312
9313
9314







-
+







int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = data[0], *nsObjPtr;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    int objc;
    Tcl_Obj **objv;

    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];

9300
9301
9302
9303
9304
9305
9306
9307

9308
9309
9310


9311
9312
9313
9314
9315
9316
9317
9335
9336
9337
9338
9339
9340
9341

9342
9343
9344
9345
9346
9347
9348
9349
9350
9351
9352
9353
9354







-
+



+
+







    iPtr->lookupNsPtr = (Namespace *) nsPtr;
    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}

int
TclNRReleaseValues(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    int i = 0;
    (void)dummy;

    while (i < 4) {
	if (data[i]) {
	    Tcl_DecrRefCount((Tcl_Obj *) data[i]);
	} else {
	    break;
	}
	i++;
9387
9388
9389
9390
9391
9392
9393
9394

9395
9396
9397
9398
9399
9400
9401

9402
9403
9404
9405
9406
9407
9408
9424
9425
9426
9427
9428
9429
9430

9431
9432
9433
9434
9435
9436
9437
9438
9439
9440
9441
9442
9443
9444
9445
9446







-
+







+







    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            clientData, NULL, NULL);
    return TCL_OK;
}

int
TclNRYieldToObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    Tcl_Obj *listPtr, *nsObjPtr;
    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
9443
9444
9445
9446
9447
9448
9449

9450

9451
9452
9453
9454
9455
9456
9457
9481
9482
9483
9484
9485
9486
9487
9488

9489
9490
9491
9492
9493
9494
9495
9496







+
-
+








static int
RewindCoroutineCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    (void)result;
    return Tcl_RestoreInterpState(interp, data[0]);
    return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]);
}

static int
RewindCoroutine(
    CoroutineData *corPtr,
    int result)
{
9468
9469
9470
9471
9472
9473
9474
9475

9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490

9491
9492
9493
9494
9495
9496
9497
9507
9508
9509
9510
9511
9512
9513

9514
9515
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528

9529
9530
9531
9532
9533
9534
9535
9536







-
+














-
+







    return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}

static void
DeleteCoroutine(
    ClientData clientData)
{
    CoroutineData *corPtr = clientData;
    CoroutineData *corPtr = (CoroutineData *)clientData;
    Tcl_Interp *interp = corPtr->eePtr->interp;
    NRE_callback *rootPtr = TOP_CB(interp);

    if (COR_IS_SUSPENDED(corPtr)) {
	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
    }
}

static int
NRCoroutineCallerCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This is the last callback in the caller execEnv, right before switching
     * to the coroutine's
     */

9529
9530
9531
9532
9533
9534
9535
9536

9537
9538
9539
9540
9541
9542
9543
9568
9569
9570
9571
9572
9573
9574

9575
9576
9577
9578
9579
9580
9581
9582







-
+








static int
NRCoroutineExitCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This runs at the bottom of the Coroutine's execEnv: it will be executed
     * when the coroutine returns or is wound down, but not when it yields. It
     * deletes the coroutine and restores the caller's environment.
     */
9594
9595
9596
9597
9598
9599
9600
9601

9602
9603
9604

9605
9606
9607
9608
9609
9610
9611
9633
9634
9635
9636
9637
9638
9639

9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651







-
+



+








int
TclNRCoroutineActivateCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    CoroutineData *corPtr = (CoroutineData *)data[0];
    int type = PTR2INT(data[1]);
    int numLevels, unused;
    int *stackLevel = &unused;
    (void)result;

    if (!corPtr->stackLevel) {
        /*
         * -- Coroutine is suspended --
         * Push the callback to restore the caller's context on yield or
         * return.
         */
9675
9676
9677
9678
9679
9680
9681
9682


9683
9684
9685
9686
9687
9688
9689
9715
9716
9717
9718
9719
9720
9721

9722
9723
9724
9725
9726
9727
9728
9729
9730







-
+
+







TclNREvalList(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    int objc;
    Tcl_Obj **objv;
    Tcl_Obj *listPtr = data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];
    (void)result;

    Tcl_IncrRefCount(listPtr);

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
9697
9698
9699
9700
9701
9702
9703
9704

9705
9706
9707
9708
9709
9710

9711
9712
9713
9714
9715
9716
9717
9738
9739
9740
9741
9742
9743
9744

9745
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
9759







-
+






+







 *      Implementation of [::tcl::unsupported::corotype] command.
 *
 *----------------------------------------------------------------------
 */

static int
CoroTypeObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    (void)dummy;

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

    /*
9728
9729
9730
9731
9732
9733
9734
9735

9736
9737
9738
9739
9740
9741
9742
9770
9771
9772
9773
9774
9775
9776

9777
9778
9779
9780
9781
9782
9783
9784







-
+







    }

    /*
     * An active coroutine is "active". Can't tell what it might do in the
     * future.
     */

    corPtr = cmdPtr->objClientData;
    corPtr = (CoroutineData *)cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
        return TCL_OK;
    }

    /*
     * Inactive coroutines are classified by the (effective) command used to
9782
9783
9784
9785
9786
9787
9788
9789

9790
9791
9792
9793
9794

9795
9796
9797
9798
9799
9800

9801
9802
9803
9804
9805
9806
9807
9824
9825
9826
9827
9828
9829
9830

9831
9832
9833
9834
9835

9836
9837
9838
9839
9840
9841
9842
9843
9844
9845
9846
9847
9848
9849
9850







-
+




-
+






+








    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objPtr), NULL);
        return NULL;
    }
    return cmdPtr->objClientData;
    return (CoroutineData *)cmdPtr->objClientData;
}

static int
TclNRCoroInjectObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    (void)dummy;

    /*
     * Usage more or less like tailcall:
     *   coroinject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
9832
9833
9834
9835
9836
9837
9838
9839

9840
9841
9842
9843
9844
9845
9846
9847

9848
9849
9850
9851
9852
9853
9854
9875
9876
9877
9878
9879
9880
9881

9882
9883
9884
9885
9886
9887
9888
9889
9890
9891
9892
9893
9894
9895
9896
9897
9898







-
+








+







    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

static int
TclNRCoroProbeObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    int numLevels, unused;
    int *stackLevel = &unused;
    (void)dummy;

    /*
     * Usage more or less like tailcall:
     *   coroprobe coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
9933
9934
9935
9936
9937
9938
9939
9940
9941


9942
9943
9944
9945

9946
9947
9948
9949
9950
9951
9952
9977
9978
9979
9980
9981
9982
9983


9984
9985
9986
9987
9988
9989
9990
9991
9992
9993
9994
9995
9996
9997







-
-
+
+




+








static int
InjectHandler(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    Tcl_Obj *listPtr = data[1];
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int objc;
    Tcl_Obj **objv;
    (void)result;

    if (!isProbe) {
        /*
         * If this is [coroinject], add the extra arguments now.
         */

        if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
9979
9980
9981
9982
9983
9984
9985
9986
9987


9988
9989
9990
9991
9992
9993
9994
10024
10025
10026
10027
10028
10029
10030


10031
10032
10033
10034
10035
10036
10037
10038
10039







-
-
+
+








static int
InjectHandlerPostCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    Tcl_Obj *listPtr = data[1];
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int numLevels;

    /*
     * Delete the command words for what we just executed.
     */
10025
10026
10027
10028
10029
10030
10031
10032

10033
10034
10035
10036
10037
10038

10039
10040
10041
10042
10043
10044
10045
10070
10071
10072
10073
10074
10075
10076

10077
10078
10079
10080
10081
10082
10083
10084
10085
10086
10087
10088
10089
10090
10091







-
+






+







 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRInjectObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    (void)dummy;

    /*
     * Usage more or less like tailcall:
     *   inject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
10075
10076
10077
10078
10079
10080
10081
10082

10083
10084
10085
10086
10087
10088
10089
10121
10122
10123
10124
10125
10126
10127

10128
10129
10130
10131
10132
10133
10134
10135







-
+







int
TclNRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = clientData;
    CoroutineData *corPtr = (CoroutineData *)clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "coroutine \"%s\" is already running",
                TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
10145
10146
10147
10148
10149
10150
10151

10152
10153
10154
10155
10156
10157
10158
10191
10192
10193
10194
10195
10196
10197
10198
10199
10200
10201
10202
10203
10204
10205







+







{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *procName, *simpleName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    procName = TclGetString(objv[1]);
10175
10176
10177
10178
10179
10180
10181
10182

10183
10184
10185
10186
10187
10188
10189
10222
10223
10224
10225
10226
10227
10228

10229
10230
10231
10232
10233
10234
10235
10236







-
+







    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = ckalloc(sizeof(CoroutineData));
    corPtr = (CoroutineData *)ckalloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
10197
10198
10199
10200
10201
10202
10203
10204

10205
10206
10207
10208
10209
10210
10211
10244
10245
10246
10247
10248
10249
10250

10251
10252
10253
10254
10255
10256
10257
10258







-
+







     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = ckalloc(sizeof(Tcl_HashTable));
	corPtr->lineLABCPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,
10267
10268
10269
10270
10271
10272
10273
10274

10275
10276
10277
10278
10279

10280
10281
10282
10283
10284
10285
10286
10314
10315
10316
10317
10318
10319
10320

10321
10322
10323
10324
10325
10326
10327
10328
10329
10330
10331
10332
10333
10334







-
+





+








/*
 * This is used in the [info] ensemble
 */

int
TclInfoCoroutineCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    (void)dummy;

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

    if (corPtr && !(corPtr->cmdPtr->flags & CMD_IS_DELETED)) {

Changes to generic/tclBinary.c.

366
367
368
369
370
371
372


373
374
375
376
377
378
379
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381







+
+







#ifdef TCL_MEM_DEBUG
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetByteArrayObj(objPtr, bytes, length);
    return objPtr;
#else /* if not TCL_MEM_DEBUG */
    (void)file;
    (void)line;
    return Tcl_NewByteArrayObj(bytes, length);
#endif /* TCL_MEM_DEBUG */
}

/*
 *---------------------------------------------------------------------------
 *
407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423







-
+







	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclInvalidateStringRep(objPtr);

    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
    }
    SET_BYTEARRAY(&ir, byteArrayPtr);
516
517
518
519
520
521
522
523

524
525
526
527
528
529
530
518
519
520
521
522
523
524

525
526
527
528
529
530
531
532







-
+







		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    if (newLength > byteArrayPtr->allocated) {
	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
	byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
	byteArrayPtr->allocated = newLength;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    byteArrayPtr->used = newLength;
    return byteArrayPtr->bytes;
}
543
544
545
546
547
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
545
546
547
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







-
+









+












-
+







 *	A ByteArray object is stored as the internal rep of objPtr.
 *
 *----------------------------------------------------------------------
 */

static int
SetByteArrayFromAny(
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Interp *dummy,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    size_t length;
    int improper = 0;
    const char *src, *srcEnd;
    unsigned char *dst;
    Tcl_UniChar ch = 0;
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;
    (void)dummy;

    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {
	return TCL_OK;
    }

    src = TclGetString(objPtr);
    length = objPtr->length;
    srcEnd = src + length;

    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	improper = improper || (ch > 255);
	*dst++ = UCHAR(ch);
    }

    byteArrayPtr->used = dst - byteArrayPtr->bytes;
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679







-
+




















-
+







    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}

static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr = (ByteArray *)ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
820
821
822
823
824

825
826
827
828
829
830
831
832

833
834
835
836
837
838
839
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834

835
836
837
838
839
840
841
842







-
+











-
+







-
+








	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	    ptr = (ByteArray *)attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	    ptr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
    }

    if (bytes) {
908
909
910
911
912
913
914

915
916
917
918
919
920
921
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925







+







    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *errorValue, *str;
    int offset, size, length;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
	return TCL_ERROR;
    }

    /*
1409
1410
1411
1412
1413
1414
1415
1416

1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
1413
1414
1415
1416
1417
1418
1419

1420
1421

1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432







-
+

-



+







    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size, length;
    int offset, size, length, i;

    int i;
    Tcl_Obj *valuePtr, *elementPtr;
    Tcl_HashTable numberCacheHash;
    Tcl_HashTable *numberCachePtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"value formatString ?varName ...?");
	return TCL_ERROR;
    }
    numberCachePtr = &numberCacheHash;
1942
1943
1944
1945
1946
1947
1948
1949
1950


1951
1952
1953
1954
1955
1956
1957
1946
1947
1948
1949
1950
1951
1952


1953
1954
1955
1956
1957
1958
1959
1960
1961







-
-
+
+







    int type)			/* What type of thing are we copying? */
{
    switch (NeedReversing(type)) {
    case 0:
	memcpy(to, from, length);
	break;
    case 1: {
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	switch (length) {
	case 4:
	    toPtr[0] = fromPtr[3];
	    toPtr[1] = fromPtr[2];
	    toPtr[2] = fromPtr[1];
	    toPtr[3] = fromPtr[0];
1966
1967
1968
1969
1970
1971
1972
1973
1974


1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988


1989
1990
1991
1992
1993
1994
1995
1970
1971
1972
1973
1974
1975
1976


1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990


1991
1992
1993
1994
1995
1996
1997
1998
1999







-
-
+
+












-
-
+
+







	    toPtr[6] = fromPtr[1];
	    toPtr[7] = fromPtr[0];
	    break;
	}
	break;
    }
    case 2: {
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	toPtr[0] = fromPtr[4];
	toPtr[1] = fromPtr[5];
	toPtr[2] = fromPtr[6];
	toPtr[3] = fromPtr[7];
	toPtr[4] = fromPtr[0];
	toPtr[5] = fromPtr[1];
	toPtr[6] = fromPtr[2];
	toPtr[7] = fromPtr[3];
	break;
    }
    case 3: {
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;

	toPtr[0] = fromPtr[3];
	toPtr[1] = fromPtr[2];
	toPtr[2] = fromPtr[1];
	toPtr[3] = fromPtr[0];
	toPtr[4] = fromPtr[7];
	toPtr[5] = fromPtr[6];
2290
2291
2292
2293
2294
2295
2296
2297

2298
2299
2300
2301
2302
2303
2304
2294
2295
2296
2297
2298
2299
2300

2301
2302
2303
2304
2305
2306
2307
2308







-
+







	} else {
	    Tcl_HashTable *tablePtr = *numberCachePtrPtr;
	    Tcl_HashEntry *hPtr;
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
	    if (!isNew) {
		return Tcl_GetHashValue(hPtr);
		return (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	    }
	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
		Tcl_Obj *objPtr = Tcl_NewWideIntObj(value);

		Tcl_IncrRefCount(objPtr);
		Tcl_SetHashValue(hPtr, objPtr);
		return objPtr;
2413
2414
2415
2416
2417
2418
2419
2420

2421
2422
2423
2424
2425
2426
2427
2417
2418
2419
2420
2421
2422
2423

2424
2425
2426
2427
2428
2429
2430
2431







-
+








    if (numberCachePtr == NULL) {
	return;
    }

    hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
    while (hEntry != NULL) {
	Tcl_Obj *value = Tcl_GetHashValue(hEntry);
	Tcl_Obj *value = (Tcl_Obj *)Tcl_GetHashValue(hEntry);

	if (value != NULL) {
	    Tcl_DecrRefCount(value);
	}
	hEntry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(numberCachePtr);
2459
2460
2461
2462
2463
2464
2465
2466

2467
2468
2469
2470
2471
2472
2473
2474

2475
2476
2477
2478
2479
2480
2481
2463
2464
2465
2466
2467
2468
2469

2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486







-
+








+







 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryEncodeHex(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data = NULL;
    unsigned char *cursor = NULL;
    int offset = 0, count = 0;
    (void)dummy;

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

    TclNewObj(resultObj);
2503
2504
2505
2506
2507
2508
2509
2510

2511
2512
2513
2514
2515
2516
2517
2518
2519
2520

2521
2522
2523
2524
2525
2526
2527
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533







-
+










+







 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecodeHex(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor, c;
    int i, index, value, size, count = 0, cut = 0, strict = 0;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
2622
2623
2624
2625
2626
2627
2628
2629

2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641

2642
2643
2644
2645
2646
2647
2648
2628
2629
2630
2631
2632
2633
2634

2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655







-
+












+







	if (cursor > limit) {				\
	    Tcl_Panic("limit hit");			\
	}						\
    } while (0)

static int
BinaryEncode64(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
    (void)dummy;

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
2728
2729
2730
2731
2732
2733
2734
2735

2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748

2749
2750
2751
2752
2753
2754
2755
2735
2736
2737
2738
2739
2740
2741

2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763







-
+













+







 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryEncodeUu(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int offset, count, rawLength, n, i, j, bits, index;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    int wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
    (void)dummy;

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
2845
2846
2847
2848
2849
2850
2851
2852

2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2853
2854
2855
2856
2857
2858
2859

2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879







-
+











+







 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecodeUu(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, count = 0, strict = 0, lineLen;
    unsigned char c;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
3008
3009
3010
3011
3012
3013
3014
3015

3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027

3028
3029
3030
3031
3032
3033
3034
3017
3018
3019
3020
3021
3022
3023

3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044







-
+












+







 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecode64(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend, c = '\0';
    unsigned char *begin = NULL;
    unsigned char *cursor = NULL;
    int strict = 0;
    int i, index, size, cut = 0, count = 0;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",

Changes to generic/tclClock.c.

105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
105
106
107
108
109
110
111

112
113
114
115
116
117
118
119







-
+







				 * epoch */
    Tcl_WideInt localSeconds;	/* Local time expressed in nominal seconds
				 * from the Posix epoch */
    int tzOffset;		/* Time zone offset in seconds east of
				 * Greenwich */
    Tcl_Obj *tzName;		/* Time zone name */
    int julianDay;		/* Julian Day Number in local time zone */
    enum {BCE=1, CE=0} era;	/* Era */
    int isBce;			/* 1 if BCE */
    int gregorian;		/* Flag == 1 if the date is Gregorian */
    int year;			/* Year of the era */
    int dayOfYear;		/* Day of the year (1 January == 1) */
    int month;			/* Month number */
    int dayOfMonth;		/* Day of the month */
    int iso8601Year;		/* ISO8601 week-based year */
    int iso8601Week;		/* ISO8601 week number */
271
272
273
274
275
276
277
278

279
280

281
282
283
284
285
286
287
271
272
273
274
275
276
277

278
279

280
281
282
283
284
285
286
287







-
+

-
+







	return;
    }

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

    data = ckalloc(sizeof(ClockClientData));
    data = (ClockClientData *)ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = ckalloc(LIT__END * sizeof(Tcl_Obj*));
    data->literals = (Tcl_Obj **)ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.
332
333
334
335
336
337
338
339

340
341
342
343
344
345
346
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346







-
+







static int
ClockConvertlocaltoutcObjCmd(
    ClientData clientData,	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    ClockClientData *data = clientData;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;
426
427
428
429
430
431
432
433

434
435
436
437
438
439
440
426
427
428
429
430
431
432

433
434
435
436
437
438
439
440







-
+







    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;

    /*
     * Check params.
     */

490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
490
491
492
493
494
495
496

497
498
499
500
501
502
503
504







-
+







    Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
	    Tcl_NewWideIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
	    Tcl_NewWideIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
	    literals[fields.era ? LIT_BCE : LIT_CE]);
	    literals[fields.isBce ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
	    Tcl_NewWideIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
	    Tcl_NewWideIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
	    Tcl_NewWideIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
580
581
582
583
584
585
586
587

588
589
590
591
592

593
594
595
596
597
598
599
600
601
602
603

604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
580
581
582
583
584
585
586

587
588
589
590
591

592
593
594
595
596
597
598
599
600
601
602

603
604
605
606
607
608
609
610
611
612

613
614
615
616
617
618
619
620







-
+




-
+










-
+









-
+







    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
    if (FetchEraField(interp, dict, literals[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_YEAR], &fields.year)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_MONTH], &fields.month)
		!= TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFMONTH],
		&fields.dayOfMonth) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.era = era;
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearMonthDay(&fields, changeover);

664
665
666
667
668
669
670
671

672
673
674
675
676

677
678
679
680
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
664
665
666
667
668
669
670

671
672
673
674
675

676
677
678
679
680
681
682
683
684
685
686

687
688
689
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704







-
+




-
+










-
+









-
+







    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = clientData;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *literals = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int era = 0;
    int isBce = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, literals[LIT_ERA], &era) != TCL_OK
    if (FetchEraField(interp, dict, literals[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601YEAR],
		&fields.iso8601Year) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_ISO8601WEEK],
		&fields.iso8601Week) != TCL_OK
	    || FetchIntField(interp, dict, literals[LIT_DAYOFWEEK],
		&fields.dayOfWeek) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }
    fields.era = era;
    fields.isBce = isBce;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearWeekDay(&fields, changeover);

1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1089







-
+







	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

    fields->era = CE;
    fields->isBce = 0;
    fields->year = timeVal->tm_year + 1900;
    fields->month = timeVal->tm_mon + 1;
    fields->dayOfMonth = timeVal->tm_mday;
    GetJulianDayFromEraYearMonthDay(fields, changeover);

    /*
     * Convert that value to seconds.
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
1241
1242
1243
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
1241
1242
1243







-
+















-
+







    /*
     * Find the given date, minus three days, plus one year. That date's
     * iso8601 year is an upper bound on the ISO8601 year of the given date.
     */

    temp.julianDay = fields->julianDay - 3;
    GetGregorianEraYearDay(&temp, changeover);
    if (temp.era == BCE) {
    if (temp.isBce) {
	temp.iso8601Year = temp.year - 1;
    } else {
	temp.iso8601Year = temp.year + 1;
    }
    temp.iso8601Week = 1;
    temp.dayOfWeek = 1;
    GetJulianDayFromEraYearWeekDay(&temp, changeover);

    /*
     * temp.julianDay is now the start of an ISO8601 year, either the one
     * corresponding to the given date, or the one after. If we guessed high,
     * move one year earlier
     */

    if (fields->julianDay < temp.julianDay) {
	if (temp.era == BCE) {
	if (temp.isBce) {
	    temp.iso8601Year += 1;
	} else {
	    temp.iso8601Year -= 1;
	}
	GetJulianDayFromEraYearWeekDay(&temp, changeover);
    }

1355
1356
1357
1358
1359
1360
1361
1362

1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1355
1356
1357
1358
1359
1360
1361

1362
1363
1364

1365
1366
1367
1368
1369
1370
1371
1372







-
+


-
+







    year += n;

    /*
     * store era/year/day back into fields.
     */

    if (year <= 0) {
	fields->era = BCE;
	fields->isBce = 1;
	fields->year = 1 - year;
    } else {
	fields->era = CE;
	fields->isBce = 0;
	fields->year = year;
    }
    fields->dayOfYear = day + 1;
}

/*
 *----------------------------------------------------------------------
1426
1427
1428
1429
1430
1431
1432
1433

1434
1435
1436
1437
1438
1439
1440
1426
1427
1428
1429
1430
1431
1432

1433
1434
1435
1436
1437
1438
1439
1440







-
+







				 * given year */
    TclDateFields firstWeek;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    firstWeek.era = fields->era;
    firstWeek.isBce = fields->isBce;
    firstWeek.year = fields->iso8601Year;
    firstWeek.month = 1;
    firstWeek.dayOfMonth = 4;
    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);

    /*
     * Find Monday of week 1.
1470
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480
1481
1482
1483
1484
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483
1484







-
+







static void
GetJulianDayFromEraYearMonthDay(
    TclDateFields *fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;

    if (fields->era == BCE) {
    if (fields->isBce) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }

    /*
     * Reduce month modulo 12.
1498
1499
1500
1501
1502
1503
1504
1505

1506
1507
1508

1509
1510
1511
1512
1513
1514
1515
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
1515







-
+


-
+








    /*
     * Adjust the year after reducing the month.
     */

    fields->gregorian = 1;
    if (year < 1) {
	fields->era = BCE;
	fields->isBce = 1;
	fields->year = 1-year;
    } else {
	fields->era = CE;
	fields->isBce = 0;
	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

1576
1577
1578
1579
1580
1581
1582
1583

1584
1585
1586
1587
1588
1589
1590
1576
1577
1578
1579
1580
1581
1582

1583
1584
1585
1586
1587
1588
1589
1590







-
+








static int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
{
    int year = fields->year;

    if (fields->era == BCE) {
    if (fields->isBce) {
	year = 1 - year;
    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {
1689
1690
1691
1692
1693
1694
1695
1696

1697
1698
1699
1700
1701
1702
1703
1689
1690
1691
1692
1693
1694
1695

1696
1697
1698
1699
1700
1701
1702
1703







-
+







    const time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    struct tm *tmPtr = Tcl_GetThreadData(&tmKey, sizeof(struct tm));
    struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
    localtime_r(timePtr, tmPtr);
#else
    struct tm *sysTmPtr;

    Tcl_MutexLock(&clockMutex);
    sysTmPtr = localtime(timePtr);
1875
1876
1877
1878
1879
1880
1881
1882

1883
1884
1885
1886
1887
1888
1889
1875
1876
1877
1878
1879
1880
1881

1882
1883
1884
1885
1886
1887
1888
1889







-
+







static int
ClockParseformatargsObjCmd(
    ClientData clientData,	/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = clientData;
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj **litPtr = dataPtr->literals;
    Tcl_Obj *results[3];	/* Format, locale and timezone */
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;
    static const char *const options[] = { /* Command line options expected */
2025
2026
2027
2028
2029
2030
2031
2032

2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044

2045
2046
2047
2048
2049
2050
2051
2025
2026
2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043

2044
2045
2046
2047
2048
2049
2050
2051







-
+











-
+







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

static void
TzsetIfNecessary(void)
{
    static char* tzWas = INT2PTR(-1);	/* Previous value of TZ, protected by
    static char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
				 * clockMutex. */
    const char *tzIsNow;	/* Current value of TZ */

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    ckfree(tzWas);
	}
	tzWas = ckalloc(strlen(tzIsNow) + 1);
	tzWas = (char *)ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
2065
2066
2067
2068
2069
2070
2071
2072

2073
2074
2075
2076
2077
2078
2079
2065
2066
2067
2068
2069
2070
2071

2072
2073
2074
2075
2076
2077
2078
2079







-
+







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

static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = clientData;
    ClockClientData *data = (ClockClientData *)clientData;
    int i;

    if (data->refCount-- <= 1) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	ckfree(data->literals);

Changes to generic/tclCmdAH.c.

131
132
133
134
135
136
137


138
139
140
141
142
143
144
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146







+
+







int
Tcl_BreakObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_BREAK;
}

169
170
171
172
173
174
175

176
177
178
179
180
181
182
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i;
    int body, result, caseObjc;
    const char *stringPtr, *arg;
    Tcl_Obj *const *caseObjv;
    Tcl_Obj *armPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string ?in? ?pattern body ...? ?default body?");
	return TCL_ERROR;
    }

313
314
315
316
317
318
319

320
321
322
323
324
325
326
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varNamePtr = NULL;
    Tcl_Obj *optionVarNamePtr = NULL;
    Interp *iPtr = (Interp *) interp;
    (void)dummy;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"script ?resultVarName? ?optionVarName?");
	return TCL_ERROR;
    }

345
346
347
348
349
350
351
352
353


354
355
356
357
358
359
360
349
350
351
352
353
354
355


356
357
358
359
360
361
362
363
364







-
-
+
+







CatchObjCmdCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *varNamePtr = data[1];
    Tcl_Obj *optionVarNamePtr = data[2];
    Tcl_Obj *varNamePtr = (Tcl_Obj *)data[1];
    Tcl_Obj *optionVarNamePtr = (Tcl_Obj *)data[2];
    int rewind = iPtr->execEnvPtr->rewind;

    /*
     * We disable catch in interpreters where the limit has been exceeded.
     */

    if (rewind || Tcl_LimitExceeded(interp)) {
408
409
410
411
412
413
414

415
416
417
418
419
420
421
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dir;
    int result;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?dirName?");
	return TCL_ERROR;
    }

    if (objc == 2) {
462
463
464
465
466
467
468


469
470
471
472
473
474
475
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482







+
+







int
Tcl_ConcatObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc >= 2) {
	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
    }
    return TCL_OK;
}

/*
497
498
499
500
501
502
503


504
505
506
507
508
509
510
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519







+
+







int
Tcl_ContinueObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_CONTINUE;
}

562
563
564
565
566
567
568

569
570
571
572
573
574
575
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    int length;			/* Length of the byte array being converted */
    const char *bytesPtr;	/* Pointer to the first byte of the array */
    (void)dummy;

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc == 3) {
	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
	    return TCL_ERROR;
624
625
626
627
628
629
630

631
632
633
634
635
636
637
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    int length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */
    (void)dummy;

    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc == 3) {
684
685
686
687
688
689
690

691
692
693
694
695
696
697
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709







+







EncodingDirsObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dirListObj;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
721
722
723
724
725
726
727
728


729
730
731
732


733
734
735
736
737
738
739
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747
748
749
750
751
752
753
754







-
+
+




+
+







 * Results:
 *	Returns a standard Tcl result
 *
 *-----------------------------------------------------------------------------
 */

int
EncodingNamesObjCmd(ClientData dummy,       /* Unused */
EncodingNamesObjCmd(
		    ClientData dummy,		/* Not used. */
		    Tcl_Interp* interp,	    /* Tcl interpreter */
		    int objc,		    /* Number of command line args */
		    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    (void)dummy;

    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetEncodingNames(interp);
    return TCL_OK;
}
751
752
753
754
755
756
757
758


759
760
761
762


763
764
765
766
767
768
769
766
767
768
769
770
771
772

773
774
775
776
777
778
779
780
781
782
783
784
785
786
787







-
+
+




+
+







 * Side effects:
 *	May change the system encoding.
 *
 *-----------------------------------------------------------------------------
 */

int
EncodingSystemObjCmd(ClientData dummy,      /* Unused */
EncodingSystemObjCmd(
		     ClientData dummy,		/* Not used. */
		     Tcl_Interp* interp,    /* Tcl interpreter */
		     int objc,		    /* Number of command line args */
		     Tcl_Obj* const objv[]) /* Vector of command line args */
{
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp,
			 Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1));
795
796
797
798
799
800
801

802
803
804
805
806
807
808
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827







+







Tcl_ErrorObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options, *optName;
    (void)dummy;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "message ?errorInfo? ?errorCode?");
	return TCL_ERROR;
    }

    TclNewLiteralStringObj(options, "-code error -level 0");
839
840
841
842
843
844
845
846

847
848
849


850
851
852
853
854
855
856
858
859
860
861
862
863
864

865
866
867
868
869
870
871
872
873
874
875
876
877







-
+



+
+







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

	/* ARGSUSED */
static int
EvalCmdErrMsg(
    ClientData data[],
    ClientData dummy[],
    Tcl_Interp *interp,
    int result)
{
    (void)dummy;

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
    }
    return result;
}

871
872
873
874
875
876
877

878
879
880
881
882
883
884
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *objPtr;
    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
    int word = 0;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
928
929
930
931
932
933
934

935
936
937
938
939
940
941
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964







+







Tcl_ExitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt value;
    (void)dummy;

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

    if (objc == 1) {
987
988
989
990
991
992
993

994
995
996
997
998
999
1000
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024







+







TclNRExprObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    TclNewObj(resultPtr);
1012
1013
1014
1015
1016
1017
1018
1019
1020


1021
1022
1023
1024
1025
1026
1027
1036
1037
1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048
1049
1050
1051







-
-
+
+








static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = data[0];
    Tcl_Obj *objPtr = data[1];
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];

    if (objPtr != NULL) {
	Tcl_DecrRefCount(objPtr);
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
1117
1118
1119
1120
1121
1122
1123
1124

1125
1126
1127
1128
1129
1130

1131
1132
1133
1134
1135
1136
1137
1141
1142
1143
1144
1145
1146
1147

1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162







-
+






+







 *	May update the access time on the file, if requested by the user.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrAccessTimeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    struct utimbuf tval;
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1224
1225
1226
1227
1228
1229
1230

1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245







-
+






+







 *	user.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrModifyTimeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    struct utimbuf tval;
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
1278
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288
1289
1290

1291
1292
1293
1294
1295
1296
1297
1304
1305
1306
1307
1308
1309
1310

1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324







-
+





+







 *	Writes to an array named by the user.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrLinkStatCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
1314
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333
1341
1342
1343
1344
1345
1346
1347

1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361







-
+





+







 *	Writes to an array named by the user.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrStatCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
1350
1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362

1363
1364
1365
1366
1367
1368
1369
1378
1379
1380
1381
1382
1383
1384

1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrTypeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400

1401
1402
1403
1404
1405
1406
1407
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrSizeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
1425
1426
1427
1428
1429
1430
1431
1432

1433
1434
1435
1436
1437
1438

1439
1440
1441
1442
1443
1444
1445
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476







-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsDirectoryCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    int value = 0;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = S_ISDIR(buf.st_mode);
1463
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474


1475
1476
1477
1478
1479
1480
1481
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsExecutableCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], X_OK);
}

1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505


1506
1507
1508
1509
1510
1511
1512
1527
1528
1529
1530
1531
1532
1533

1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsExistingCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], F_OK);
}

1525
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538

1539
1540
1541
1542
1543
1544
1545
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581







-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsFileCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    int value = 0;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = S_ISREG(buf.st_mode);
1563
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581

1582
1583
1584
1585
1586
1587
1588
1599
1600
1601
1602
1603
1604
1605

1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625







-
+











+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsOwnedCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
#ifdef __CYGWIN__
#define geteuid() (short)(geteuid)()
#endif
#if !defined(_WIN32)
    Tcl_StatBuf buf;
#endif
    int value = 0;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
#if defined(_WIN32)
    value = TclWinFileOwned(objv[1]);
1610
1611
1612
1613
1614
1615
1616
1617

1618
1619
1620
1621


1622
1623
1624
1625
1626
1627
1628
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsReadableCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], R_OK);
}

1641
1642
1643
1644
1645
1646
1647
1648

1649
1650
1651
1652


1653
1654
1655
1656
1657
1658
1659
1680
1681
1682
1683
1684
1685
1686

1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsWritableCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], W_OK);
}

1672
1673
1674
1675
1676
1677
1678
1679

1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690
1691
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathDirNameCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_DIRNAME);
    if (dirPtr == NULL) {
1711
1712
1713
1714
1715
1716
1717
1718

1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathExtensionCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION);
    if (dirPtr == NULL) {
1750
1751
1752
1753
1754
1755
1756
1757

1758
1759
1760
1761
1762

1763
1764
1765
1766
1767
1768
1769
1793
1794
1795
1796
1797
1798
1799

1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathRootNameCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT);
    if (dirPtr == NULL) {
1789
1790
1791
1792
1793
1794
1795
1796

1797
1798
1799
1800
1801

1802
1803
1804
1805
1806
1807
1808
1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathTailCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL);
    if (dirPtr == NULL) {
1828
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840

1841
1842
1843
1844
1845
1846
1847
1873
1874
1875
1876
1877
1878
1879

1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathFilesystemCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *fsInfo;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fsInfo = Tcl_FSFileSystemInfo(objv[1]);
    if (fsInfo == NULL) {
1869
1870
1871
1872
1873
1874
1875
1876

1877
1878
1879
1880


1881
1882
1883
1884
1885
1886
1887
1915
1916
1917
1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathJoinCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0));
    return TCL_OK;
}
1901
1902
1903
1904
1905
1906
1907
1908

1909
1910
1911
1912
1913

1914
1915
1916
1917
1918
1919
1920
1949
1950
1951
1952
1953
1954
1955

1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathNativeNameCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_DString ds;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
	return TCL_ERROR;
1938
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950

1951
1952
1953
1954
1955
1956
1957
1987
1988
1989
1990
1991
1992
1993

1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathNormalizeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *fileName;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fileName = Tcl_FSGetNormalizedPath(interp, objv[1]);
    if (fileName == NULL) {
1976
1977
1978
1979
1980
1981
1982
1983

1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
2026
2027
2028
2029
2030
2031
2032

2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathSplitCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *res;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
2019
2020
2021
2022
2023
2024
2025
2026

2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037
2038
2070
2071
2072
2073
2074
2075
2076

2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathTypeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *typeName;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    switch (Tcl_FSGetPathType(objv[1])) {
    case TCL_PATH_ABSOLUTE:
2067
2068
2069
2070
2071
2072
2073
2074

2075
2076
2077
2078


2079
2080
2081
2082
2083
2084
2085
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FilesystemSeparatorCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	const char *separator = NULL; /* lint */

2122
2123
2124
2125
2126
2127
2128
2129

2130
2131
2132
2133


2134
2135
2136
2137
2138
2139
2140
2176
2177
2178
2179
2180
2181
2182

2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FilesystemVolumesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_FSListVolumes());
    return TCL_OK;
}
2400
2401
2402
2403
2404
2405
2406

2407
2408
2409
2410
2411
2412
2413
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr;
    (void)dummy;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
	return TCL_ERROR;
    }

    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
2428
2429
2430
2431
2432
2433
2434
2435

2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454

2455
2456
2457
2458
2459
2460
2461
2485
2486
2487
2488
2489
2490
2491

2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510

2511
2512
2513
2514
2515
2516
2517
2518







-
+


















-
+








static int
ForSetupCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = data[0];
    ForIterData *iterPtr = (ForIterData *)data[0];

    if (result != TCL_OK) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
	}
	TclSmallFreeEx(interp, iterPtr);
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return TCL_OK;
}

int
TclNRForIterCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = data[0];
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj;

    switch (result) {
    case TCL_OK:
    case TCL_CONTINUE:
	/*
	 * We need to reset the result before evaluating the expression.
2483
2484
2485
2486
2487
2488
2489
2490
2491


2492
2493
2494
2495
2496
2497
2498
2540
2541
2542
2543
2544
2545
2546


2547
2548
2549
2550
2551
2552
2553
2554
2555







-
-
+
+







static int
ForCondCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = data[0];
    Tcl_Obj *boolObj = data[1];
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj = (Tcl_Obj *)data[1];
    int value;

    if (result != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFreeEx(interp, iterPtr);
	return result;
    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
2521
2522
2523
2524
2525
2526
2527
2528

2529
2530
2531
2532
2533
2534
2535
2578
2579
2580
2581
2582
2583
2584

2585
2586
2587
2588
2589
2590
2591
2592







-
+







static int
ForNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = data[0];
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *next = iterPtr->next;

    if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
		NULL);

	/*
2545
2546
2547
2548
2549
2550
2551
2552

2553
2554
2555
2556
2557
2558
2559
2602
2603
2604
2605
2606
2607
2608

2609
2610
2611
2612
2613
2614
2615
2616







-
+








static int
ForPostNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = data[0];
    ForIterData *iterPtr = (ForIterData *)data[0];

    if ((result != TCL_BREAK) && (result != TCL_OK)) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
	    TclSmallFreeEx(interp, iterPtr);
	}
	return result;
2593
2594
2595
2596
2597
2598
2599


2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619

2620
2621
2622
2623
2624
2625
2626
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686







+
+




















+







int
TclNRForeachCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
}

int
Tcl_LmapObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRLmapCmd, dummy, objc, objv);
}

int
TclNRLmapCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;
    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}

static inline int
EachloopCmd(
    Tcl_Interp *interp,		/* Our context for variables and script
				 * evaluation. */
2650
2651
2652
2653
2654
2655
2656
2657

2658
2659
2660
2661
2662
2663
2664
2710
2711
2712
2713
2714
2715
2716

2717
2718
2719
2720
2721
2722
2723
2724







-
+







     *		statePtr->argvList[i].
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = TclStackAlloc(interp,
    statePtr = (struct ForeachState *)TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;
2751
2752
2753
2754
2755
2756
2757
2758

2759
2760
2761
2762
2763
2764
2765
2811
2812
2813
2814
2815
2816
2817

2818
2819
2820
2821
2822
2823
2824
2825







-
+








static int
ForeachLoopStep(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    struct ForeachState *statePtr = data[0];
    struct ForeachState *statePtr = (struct ForeachState *)data[0];

    /*
     * Process the result code from this run of the [foreach] body. Note that
     * this switch uses fallthroughs in several places. Maintainer aware!
     */

    switch (result) {
2902
2903
2904
2905
2906
2907
2908

2909
2910
2911
2912
2913
2914
2915
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976







+







Tcl_FormatObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr;		/* Where result is stored finally. */
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?");
	return TCL_ERROR;
    }

    resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2);

Changes to generic/tclCmdIL.c.

218
219
220
221
222
223
224

225
226
227
228
229
230
231
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232







+







TclNRIfObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *boolObj;
    (void)dummy;

    if (objc <= 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"wrong # args: no expression after \"%s\" argument",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
247
248
249
250
251
252
253
254

255
256

257
258
259
260
261
262
263
248
249
250
251
252
253
254

255
256

257
258
259
260
261
262
263
264







-
+

-
+







IfConditionCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *const *objv = data[1];
    Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1];
    int i = PTR2INT(data[2]);
    Tcl_Obj *boolObj = data[3];
    Tcl_Obj *boolObj = (Tcl_Obj *)data[3];
    int value, thenScriptIndex = 0;
    const char *clause;

    if (result != TCL_OK) {
	TclDecrRefCount(boolObj);
	return result;
    }
391
392
393
394
395
396
397

398
399
400
401
402
403
404
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406







+







Tcl_IncrObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *newValuePtr, *incrPtr;
    (void)dummy;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
	return TCL_ERROR;
    }

    if (objc == 3) {
476
477
478
479
480
481
482

483
484
485
486
487
488
489
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *listObjPtr;
    (void)dummy;

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

    name = TclGetString(objv[1]);
538
539
540
541
542
543
544

545
546
547
548
549
550
551
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    Proc *procPtr;
    int numBytes;
    (void)dummy;

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

    name = TclGetString(objv[1]);
596
597
598
599
600
601
602

603
604
605
606
607
608
609
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614







+







InfoCmdCountCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;

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

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->cmdCount));
648
649
650
651
652
653
654

655
656
657
658
659
660
661
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667







+







    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    int i;
    (void)dummy;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {
707
708
709
710
711
712
713
714

715
716
717
718

719
720
721
722
723
724
725
713
714
715
716
717
718
719

720
721
722
723

724
725
726
727
728
729
730
731







-
+



-
+







	 * Special case for when the pattern doesn't include any of glob's
	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = Tcl_GetHashValue(entryPtr);
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		elemObjPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
	    return TCL_OK;
	}
	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
738
739
740
741
742
743
744
745

746
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
744
745
746
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







-
+















-
+



-
+







		}
	    }
	    if (entryPtr == NULL) {
		tablePtr = &globalNsPtr->cmdTable;
		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
	    }
	    if (entryPtr != NULL) {
		cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr);
		Tcl_ListObjAppendElement(interp, listPtr,
			Tcl_NewStringObj(cmdName, -1));
		Tcl_SetObjResult(interp, listPtr);
		return TCL_OK;
	    }
	}
    } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
	/*
	 * The pattern is non-trivial, but either there is no explicit path or
	 * there is an explicit namespace in the pattern. In both cases, the
	 * old matching scheme is perfect.
	 */

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = Tcl_GetHashValue(entryPtr);
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
780
781
782
783
784
785
786
787

788
789
790
791
792
793
794
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800







-
+







	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr,
				Tcl_NewStringObj(cmdName, -1));
		    }
		}
811
812
813
814
815
816
817
818

819
820
821
822
823
824
825
817
818
819
820
821
822
823

824
825
826
827
828
829
830
831







-
+







	 * We keep a hash of the objects already added to the result list.
	 */

	Tcl_InitObjHashTable(&addedCommandsTable);

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		(void) Tcl_CreateHashEntry(&addedCommandsTable,
			elemObjPtr, &isNew);
	    }
837
838
839
840
841
842
843
844

845
846
847
848
849
850
851
843
844
845
846
847
848
849

850
851
852
853
854
855
856
857







-
+







		continue;
	    }
	    if (pathNsPtr == globalNsPtr) {
		foundGlobal = 1;
	    }
	    entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
			    elemObjPtr, &isNew);
		    if (isNew) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
864
865
866
867
868
869
870
871

872
873
874
875
876
877
878
870
871
872
873
874
875
876

877
878
879
880
881
882
883
884







-
+







	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if (!foundGlobal) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    if (Tcl_FindHashEntry(&addedCommandsTable,
			    (char *) elemObjPtr) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {
914
915
916
917
918
919
920


921
922
923
924
925
926
927
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935







+
+







static int
InfoCompleteCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

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

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
	    TclObjCommandComplete(objv[1])));
956
957
958
959
960
961
962

963
964
965
966
967
968
969
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *procName, *argName;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *valueObjPtr;
    (void)dummy;

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

    procName = TclGetString(objv[1]);
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047
1048
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *target;
    Interp *iPtr;
    (void)dummy;

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

    target = interp;
1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName;
    Var *varPtr;
    (void)dummy;

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

    varName = TclGetString(objv[1]);
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    int level, code = TCL_OK;
    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    int topLevel = 0;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
	return TCL_ERROR;
    }

    while (corPtr) {
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322
1323
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1335







-
+







	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */

	CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *fPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));

	*fPtr = *framePtr;

	/*
	 * Note:
	 * Type BC => f.data.eval.path	  is not used.
	 *	      f.data.tebc.codePtr is used instead.
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
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







-
+













-
+







	     */

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {
		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
		if (efiPtr->fields[i].proc) {
		    lv[lc++] =
			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
		} else {
		    lv[lc++] = efiPtr->fields[i].clientData;
		    lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData;
		}
	    }
	}
    }

    /*
     * 'level'. Common to all frame types. Conditional on having an associated
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *script;
    int code;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }

    script = Tcl_NewStringObj(
1533
1534
1535
1536
1537
1538
1539

1540
1541
1542
1543
1544
1545
1546
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560







+







InfoHostnameCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name;
    (void)dummy;

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

    name = Tcl_GetHostName();
1579
1580
1581
1582
1583
1584
1585

1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607







+







InfoLevelCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;

    if (objc == 1) {		/* Just "info level" */
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->varFramePtr->level));
	return TCL_OK;
    }

    if (objc == 2) {
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682







+







InfoLibraryCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *libDirName;
    (void)dummy;

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

    libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730







+







InfoLoadedCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *interpName, *packageName;
    (void)dummy;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp? ?packageName?");
	return TCL_ERROR;
    }

    if (objc < 2) {		/* Get loaded pkgs in all interpreters. */
1747
1748
1749
1750
1751
1752
1753


1754
1755
1756
1757
1758
1759
1760
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779







+
+







static int
InfoNameOfExecutableCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());
    return TCL_OK;
}
1784
1785
1786
1787
1788
1789
1790

1791
1792
1793
1794
1795
1796
1797
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817







+







InfoPatchLevelCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *patchlevel;
    (void)dummy;

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

    patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL,
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876







+







#endif
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr, *realCmdPtr;
    (void)dummy;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * procs.
     */

    if (objc == 1) {
1891
1892
1893
1894
1895
1896
1897
1898

1899
1900
1901
1902
1903
1904
1905
1912
1913
1914
1915
1916
1917
1918

1919
1920
1921
1922
1923
1924
1925
1926







-
+







     */

    listPtr = Tcl_NewListObj(0, NULL);
#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    cmdPtr = Tcl_GetHashValue(entryPtr);
	    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

	    if (!TclIsProc(cmdPtr)) {
		realCmdPtr = (Command *)
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
1916
1917
1918
1919
1920
1921
1922
1923

1924
1925
1926

1927
1928
1929
1930
1931
1932
1933
1937
1938
1939
1940
1941
1942
1943

1944
1945
1946

1947
1948
1949
1950
1951
1952
1953
1954







-
+


-
+







	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		cmdPtr = Tcl_GetHashValue(entryPtr);
		cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);

		if (!TclIsProc(cmdPtr)) {
		    realCmdPtr = (Command *)
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
1962
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973

1974
1975
1976
1977
1978
1979
1980
1983
1984
1985
1986
1987
1988
1989

1990
1991
1992
1993

1994
1995
1996
1997
1998
1999
2000
2001







-
+



-
+







	 * decided not to "fix" it in 8.3, leaving the behavior slightly
	 * different.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			cmdPtr = Tcl_GetHashValue(entryPtr);
			cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
			realCmdPtr = (Command *) TclGetOriginalCommand(
				(Tcl_Command) cmdPtr);

			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
				&& TclIsProc(realCmdPtr))) {
			    Tcl_ListObjAppendElement(interp, listPtr,
				    Tcl_NewStringObj(cmdName, -1));
2018
2019
2020
2021
2022
2023
2024


2025
2026
2027
2028
2029
2030
2031
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054







+
+







InfoScriptCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;

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

    if (objc == 2) {
	if (iPtr->scriptFile != NULL) {
2064
2065
2066
2067
2068
2069
2070


2071
2072
2073
2074
2075
2076
2077
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102







+
+







static int
InfoSharedlibCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

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

#ifdef TCL_SHLIB_EXT
    Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1));
2103
2104
2105
2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142







+







InfoTclVersionCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *version;
    (void)dummy;

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

    version = Tcl_GetVar2Ex(interp, "tcl_version", NULL,
2146
2147
2148
2149
2150
2151
2152

2153
2154
2155
2156
2157
2158
2159
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186







+







InfoCmdTypeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command command;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
2198
2199
2200
2201
2202
2203
2204

2205
2206
2207
2208
2209
2210
2211
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int length, listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
    (void)dummy;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
2285
2286
2287
2288
2289
2290
2291

2292
2293
2294
2295
2296
2297
2298
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listCopyPtr;
    Tcl_Obj **listObjv;		/* The contents of the list. */
    int listObjc;		/* The length of the list. */
    int code = TCL_OK;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
	return TCL_ERROR;
    }

    listCopyPtr = TclListObjCopy(interp, objv[1]);
2355
2356
2357
2358
2359
2360
2361
2362
2363

2364
2365
2366
2367
2368
2369
2370
2384
2385
2386
2387
2388
2389
2390

2391
2392
2393
2394
2395
2396
2397
2398
2399







-

+







int
Tcl_LindexObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
	return TCL_ERROR;
    }

    /*
2416
2417
2418
2419
2420
2421
2422

2423
2424
2425
2426
2427
2428
2429
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    int index, len, result;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &len);
2497
2498
2499
2500
2501
2502
2503

2504
2505
2506
2507
2508
2509
2510
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541







+







Tcl_ListObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    (void)dummy;
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise set the interpreter's result object to be a list object.
     */

    if (objc > 1) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
2534
2535
2536
2537
2538
2539
2540

2541
2542
2543
2544
2545
2546
2547
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    (void)dummy;

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

    result = TclListObjLength(interp, objv[1], &listLen);
2573
2574
2575
2576
2577
2578
2579
2580

2581
2582
2583
2584
2585
2586
2587
2588

2589
2590
2591
2592
2593
2594
2595
2605
2606
2607
2608
2609
2610
2611

2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628







-
+








+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LpopObjCmd(
    ClientData notUsed,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
	return TCL_ERROR;
    }

    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
2666
2667
2668
2669
2670
2671
2672
2673

2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684
2685
2686
2699
2700
2701
2702
2703
2704
2705

2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LrangeObjCmd(
    ClientData notUsed,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, first, last, result;
    (void)dummy;

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

    result = TclListObjLength(interp, objv[1], &listLen);
2734
2735
2736
2737
2738
2739
2740
2741

2742
2743
2744
2745
2746
2747
2748

2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769

2770
2771
2772
2773
2774
2775
2776
2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803

2804
2805
2806
2807
2808
2809
2810
2811







-
+







+




















-
+







     */

    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

int
Tcl_LremoveObjCmd(
    ClientData notUsed,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc;
    int listLen, *idxv, prevIdx, first, num;
    Tcl_Obj *listObj;
    (void)dummy;

    /*
     * Parse the arguments.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
	return TCL_ERROR;
    }

    listObj = objv[1];
    if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
	return TCL_ERROR;
    }

    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
	return TCL_OK;
    }
    idxv = ckalloc((objc - 2) * sizeof(int));
    idxv = (int *)ckalloc((objc - 2) * sizeof(int));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    ckfree(idxv);
	    return TCL_ERROR;
	}
    }
2861
2862
2863
2864
2865
2866
2867

2868
2869
2870
2871
2872
2873
2874
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* The argument objects. */
{
    int elementCount, i, totalElems;
    Tcl_Obj *listPtr, **dataArray = NULL;
    (void)dummy;

    /*
     * Check arguments for legality:
     *		lrepeat count ?value ...?
     */

    if (objc < 2) {
2969
2970
2971
2972
2973
2974
2975

2976
2977
2978
2979
2980
2981
2982
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    int first, last, listLen, numToDelete, result;
    (void)dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
	return TCL_ERROR;
    }

3063
3064
3065
3066
3067
3068
3069
3070

3071
3072
3073
3074
3075
3076

3077
3078
3079
3080
3081
3082
3083
3100
3101
3102
3103
3104
3105
3106

3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LreverseObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj **elemv;
    int elemc, i, j;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }
    if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
3142
3143
3144
3145
3146
3147
3148
3149

3150
3151
3152
3153
3154
3155
3156
3180
3181
3182
3183
3184
3185
3186

3187
3188
3189
3190
3191
3192
3193
3194







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsearchObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
    int allocatedIndexVector = 0;
3179
3180
3181
3182
3183
3184
3185

3186
3187
3188
3189
3190
3191
3192
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231







+







    enum datatypes {
	ASCII, DICTIONARY, INTEGER, REAL
    };
    enum modes {
	EXACT, GLOB, REGEXP, SORTED
    };
    enum modes mode;
    (void)dummy;

    mode = GLOB;
    dataType = ASCII;
    isIncreasing = 1;
    allMatches = 0;
    inlineReturn = 0;
    returnSubindices = 0;
3358
3359
3360
3361
3362
3363
3364
3365

3366
3367
3368
3369
3370
3371
3372
3397
3398
3399
3400
3401
3402
3403

3404
3405
3406
3407
3408
3409
3410
3411







-
+







	    case 0:
		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv =
		sortInfo.indexv = (int *)
			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
		allocatedIndexVector = 1; /* Cannot use indexc field, as it
					   * might be decreased by 1 later. */
	    }

	    /*
	     * Fill the array by parsing each index. We don't know whether
3894
3895
3896
3897
3898
3899
3900
3901

3902
3903
3904
3905
3906
3907

3908
3909
3910
3911
3912
3913
3914
3933
3934
3935
3936
3937
3938
3939

3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsetObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */
    (void)dummy;

    /*
     * Check parameter count.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
3979
3980
3981
3982
3983
3984
3985
3986

3987
3988
3989
3990
3991
3992
3993
4019
4020
4021
4022
4023
4024
4025

4026
4027
4028
4029
4030
4031
4032
4033







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsortObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int i, j, index, indices, length, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, groupSize, groupOffset, idx, allocatedIndexVector = 0;
4009
4010
4011
4012
4013
4014
4015

4016
4017
4018
4019
4020
4021
4022
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063







+







	"-unique", NULL
    };
    enum Lsort_Switches {
	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
	LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
	return TCL_ERROR;
    }

    /*
4177
4178
4179
4180
4181
4182
4183
4184

4185
4186
4187
4188
4189
4190
4191
4218
4219
4220
4221
4222
4223
4224

4225
4226
4227
4228
4229
4230
4231
4232







-
+







	case 0:
	    sortInfo.indexv = NULL;
	    break;
	case 1:
	    sortInfo.indexv = &sortInfo.singleIndex;
	    break;
	default:
	    sortInfo.indexv =
	    sortInfo.indexv = (int *)
		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
	    allocatedIndexVector = 1;	/* Cannot use indexc field, as it
					 * might be decreased by 1 later. */
	}
	for (j=0 ; j<sortInfo.indexc ; j++) {
	    /* Prescreened values, no errors or out of range possible */
	    TclIndexEncode(NULL, indexv[j], TCL_INDEX_NONE,
4317
4318
4319
4320
4321
4322
4323
4324

4325
4326

4327
4328
4329
4330
4331
4332
4333
4358
4359
4360
4361
4362
4363
4364

4365
4366

4367
4368
4369
4370
4371
4372
4373
4374







-
+

-
+







    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elmArrSize = length * sizeof(SortElement);
    if (elmArrSize <= MAXCALLOC) {
	elementArray = ckalloc(elmArrSize);
	elementArray = (SortElement *)ckalloc(elmArrSize);
    } else {
	elementArray = malloc(elmArrSize);
	elementArray = (SortElement *)malloc(elmArrSize);
    }
    if (!elementArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no enough memory to proccess sort of %d items", length));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	sortInfo.resultCode = TCL_ERROR;
	goto done;

Changes to generic/tclCmdMZ.c.

84
85
86
87
88
89
90

91
92
93
94
95
96
97
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98







+







Tcl_PwdObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *retVal;
    (void)dummy;

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

    retVal = Tcl_FSGetCwd(interp);
138
139
140
141
142
143
144

145
146
147
148
149
150
151
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153







+







	"-nocase",	"-start",	"--",		NULL
    };
    enum options {
	REGEXP_ALL,	REGEXP_ABOUT,	REGEXP_INDICES,	REGEXP_INLINE,
	REGEXP_EXPANDED,REGEXP_LINE,	REGEXP_LINESTOP,REGEXP_LINEANCHOR,
	REGEXP_NOCASE,	REGEXP_START,	REGEXP_LAST
    };
    (void)dummy;

    indices = 0;
    about = 0;
    cflags = TCL_REG_ADVANCED;
    offset = 0;
    all = 0;
    doinline = 0;
500
501
502
503
504
505
506

507
508
509
510
511
512
513
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516







+







	"--",		NULL
    };
    enum options {
	REGSUB_ALL,	 REGSUB_COMMAND,    REGSUB_EXPANDED, REGSUB_LINE,
	REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE,   REGSUB_START,
	REGSUB_LAST
    };
    (void)dummy;

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = 0;
    command = 0;
    resultPtr = NULL;

774
775
776
777
778
779
780
781

782
783
784
785
786
787
788
777
778
779
780
781
782
783

784
785
786
787
788
789
790
791







-
+








	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    args = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
998
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1001
1002
1003
1004
1005
1006
1007

1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021







-
+





+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RenameObjCmd(
    ClientData dummy,		/* Arbitrary value passed to the command. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *oldName, *newName;
    (void)dummy;

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

    oldName = TclGetString(objv[1]);
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067







+







    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */

    int explicitResult = (0 == (objc % 2));
    int numOptionWords = objc - 1 - explicitResult;
    (void)dummy;

    if (TCL_ERROR == TclMergeReturnOptions(interp, numOptionWords, objv+1,
	    &returnOpts, &code, &level)) {
	return TCL_ERROR;
    }

    code = TclProcessReturn(interp, code, level, returnOpts);
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *encodingName = NULL;
    Tcl_Obj *fileName;
    int result;
    void **pkgFiles = NULL;
    void *names = NULL;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
	return TCL_ERROR;
    }

    fileName = objv[objc-1];
1132
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1138
1139
1140
1141
1142
1143
1144

1145
1146
1147
1148
1149
1150
1151
1152







-
+







	};
	int index;

	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
		"option", TCL_EXACT, &index)) {
	    return TCL_ERROR;
	}
	pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	pkgFiles = (void **)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	/* Make sure that during the following TclNREvalFile no filenames
	 * are recorded for inclusion in the "package files" command */
	names = *pkgFiles;
	*pkgFiles = NULL;
    }
    result = TclNREvalFile(interp, fileName, encodingName);
    if (pkgFiles) {
1177
1178
1179
1180
1181
1182
1183

1184
1185
1186
1187
1188
1189
1190
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197







+







    Tcl_UniChar ch = 0;
    int len;
    const char *splitChars;
    const char *stringPtr;
    const char *end;
    int splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;
    (void)dummy;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
    } else {
1239
1240
1241
1242
1243
1244
1245
1246

1247
1248
1249
1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260
1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
1267







-
+






-
+








		/*
		 * Don't need to fiddle with refcount...
		 */

		Tcl_SetHashValue(hPtr, objPtr);
	    } else {
		objPtr = Tcl_GetHashValue(hPtr);
		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	    }
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	}
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	char *p;
	const char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

1319
1320
1321
1322
1323
1324
1325

1326
1327
1328
1329
1330
1331
1332
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340







+







StringFirstCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int start = 0;
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375
1376
1377
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386







+







StringLastCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int last = INT_MAX - 1;
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
	return TCL_ERROR;
    }

1409
1410
1411
1412
1413
1414
1415

1416
1417
1418
1419
1420
1421
1422
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432







+







StringIndexCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, index;
    (void)dummy;

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

    /*
1481
1482
1483
1484
1485
1486
1487

1488
1489
1490
1491
1492
1493
1494
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505







+







    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int length;			/* String length */
    int index;			/* Insert index */
    Tcl_Obj *outObj;		/* Output object */
    (void)dummy;

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

    length = Tcl_GetCharLength(objv[1]);
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589







+







    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };
    (void)dummy;

    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"class ?-strict? ?-failindex var? str");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], isClasses, "class", 0,
1979
1980
1981
1982
1983
1984
1985

1986
1987
1988
1989
1990
1991
1992
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2, mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long);
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
2033
2034
2035
2036
2037
2038
2039
2040

2041
2042
2043
2044
2045
2046
2047
2046
2047
2048
2049
2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060







-
+







	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
2144
2145
2146
2147
2148
2149
2150
2151
2152


2153
2154

2155
2156
2157
2158
2159
2160
2161
2157
2158
2159
2160
2161
2162
2163


2164
2165
2166

2167
2168
2169
2170
2171
2172
2173
2174







-
-
+
+

-
+







	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
	mapLens = (int *)TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
2246
2247
2248
2249
2250
2251
2252

2253
2254
2255
2256
2257
2258
2259
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273







+







StringMatchCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int nocase = 0;
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
2298
2299
2300
2301
2302
2303
2304

2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326







+







StringRangeCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, first, last;
    (void)dummy;

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

    /*
2355
2356
2357
2358
2359
2360
2361

2362
2363
2364
2365
2366
2367
2368
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int count;
    Tcl_Obj *resultPtr;
    (void)dummy;

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

    if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440







+







StringRplcCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int first, last, length, end;
    (void)dummy;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
2485
2486
2487
2488
2489
2490
2491


2492
2493
2494
2495
2496
2497
2498
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517







+
+







static int
StringRevCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

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

    Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
    return TCL_OK;
2523
2524
2525
2526
2527
2528
2529

2530
2531
2532
2533
2534
2535
2536
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar ch = 0;
    const char *p, *string;
    int cur, index, length, numChars;
    (void)dummy;

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

    string = TclGetStringFromObj(objv[1], &length);
2584
2585
2586
2587
2588
2589
2590

2591
2592
2593
2594
2595
2596
2597
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar ch = 0;
    const char *p, *end, *string;
    int cur, index, length, numChars;
    (void)dummy;

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

    string = TclGetStringFromObj(objv[1], &length);
2651
2652
2653
2654
2655
2656
2657

2658
2659
2660
2661
2662
2663
2664
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686







+







     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string2;
    int length, i, match, nocase = 0, reqlength = -1;
    (void)dummy;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }
2725
2726
2727
2728
2729
2730
2731

2732
2733
2734
2735
2736
2737
2738
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761







+







    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, nocase, reqlength, status;
    (void)dummy;

    status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
    if (status != TCL_OK) {
	return status;
    }

    objv += objc-2;
2807
2808
2809
2810
2811
2812
2813

2814
2815
2816
2817
2818
2819
2820
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844







+







StringCatCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *objResultPtr;
    (void)dummy;

    if (objc < 2) {
	/*
	 * If there are no args, the result is an empty object.
	 * Just leave the preset empty interp result.
	 */
	return TCL_OK;
2852
2853
2854
2855
2856
2857
2858

2859
2860
2861
2862
2863
2864
2865
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890







+







StringBytesCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length;
    (void)dummy;

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

    (void) TclGetStringFromObj(objv[1], &length);
2888
2889
2890
2891
2892
2893
2894


2895
2896
2897
2898
2899
2900
2901
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928







+
+







static int
StringLenCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

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

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1])));
    return TCL_OK;
2925
2926
2927
2928
2929
2930
2931

2932
2933
2934
2935
2936
2937
2938
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *string2;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
3010
3011
3012
3013
3014
3015
3016

3017
3018
3019
3020
3021
3022
3023
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *string2;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
3095
3096
3097
3098
3099
3100
3101

3102
3103
3104
3105
3106
3107
3108
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length1, length2;
    const char *string1;
    char *string2;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);
3179
3180
3181
3182
3183
3184
3185

3186
3187
3188
3189
3190
3191
3192
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int triml, trimr, length1, length2;
    (void)dummy;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3226
3227
3228
3229
3230
3231
3232

3233
3234
3235
3236
3237
3238
3239
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim, length1, length2;
    (void)dummy;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3272
3273
3274
3275
3276
3277
3278

3279
3280
3281
3282
3283
3284
3285
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim, length1, length2;
    (void)dummy;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
    } else {
3424
3425
3426
3427
3428
3429
3430

3431
3432
3433
3434
3435
3436
3437
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471







+







TclNRSubstObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nobackslashes? ?-nocommands? ?-novariables? string");
	return TCL_ERROR;
    }

3498
3499
3500
3501
3502
3503
3504

3505
3506
3507
3508
3509
3510
3511
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546







+







    };
    enum options {
	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
	OPT_LAST
    };
    typedef int (*strCmpFn_t)(const char *, const char *);
    strCmpFn_t strCmpFn = TclUtfCmp;
    (void)dummy;

    mode = OPT_EXACT;
    foundmode = 0;
    indexVarObj = NULL;
    matchVarObj = NULL;
    numMatchesSaved = 0;
    noCase = 0;
3848
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3883
3884
3885
3886
3887
3888
3889

3890
3891
3892
3893
3894
3895
3896
3897







-
+








    /*
     * We've got a match. Find a body to execute, skipping bodies that are
     * "-".
     */

  matchFound:
    ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
    ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    *ctxPtr = *iPtr->cmdFramePtr;

    if (splitObjs) {
	/*
	 * We have to perform the GetSrc and other type dependent handling of
	 * the frame here because we are munging with the line numbers,
	 * something the other commands like if, etc. are not doing. Them are
3878
3879
3880
3881
3882
3883
3884
3885

3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899

3900
3901
3902
3903
3904
3905
3906
3913
3914
3915
3916
3917
3918
3919

3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933

3934
3935
3936
3937
3938
3939
3940
3941







-
+













-
+







	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    ctxPtr->line = ckalloc(objc * sizeof(int));
	    ctxPtr->line = (int *)ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
	} else {
	    /*
	     * This is either a dynamic code word, when all elements are
	     * relative to themselves, or something else less expected and
	     * where we have no information. The result is the same in both
	     * cases; tell the code to come that it doesn't know where it is,
	     * which triggers reversion to the old behavior.
	     */

	    int k;

	    ctxPtr->line = ckalloc(objc * sizeof(int));
	    ctxPtr->line = (int *)ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

3932
3933
3934
3935
3936
3937
3938
3939

3940
3941

3942
3943
3944
3945
3946
3947
3948
3967
3968
3969
3970
3971
3972
3973

3974
3975

3976
3977
3978
3979
3980
3981
3982
3983







-
+

-
+







    ClientData data[],		/* Data passed from Tcl_NRAddCallback above */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int result)			/* Result to return*/
{
    /* Unpack the preserved data */

    int splitObjs = PTR2INT(data[0]);
    CmdFrame *ctxPtr = data[1];
    CmdFrame *ctxPtr = (CmdFrame *)data[1];
    int pc = PTR2INT(data[2]);
    const char *pattern = data[3];
    const char *pattern = (const char *)data[3];
    int patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
3996
3997
3998
3999
4000
4001
4002

4003
4004
4005
4006
4007
4008
4009
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options;
    int len;
    (void)dummy;

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

    /*
4066
4067
4068
4069
4070
4071
4072

4073
4074
4075
4076
4077
4078
4079
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116







+







    int count;
    double totalMicroSec;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time start, stop;
#else
    Tcl_WideInt start, stop;
#endif
    (void)dummy;

    if (objc == 2) {
	count = 1;
    } else if (objc == 3) {
	result = TclGetIntFromObj(interp, objv[2], &count);
	if (result != TCL_OK) {
	    return result;
4184
4185
4186
4187
4188
4189
4190

4191
4192
4193
4194
4195
4196
4197
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235







+







	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;
    (void)dummy;

    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
4715
4716
4717
4718
4719
4720
4721

4722
4723
4724
4725
4726
4727
4728
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767







+







    int i, bodyShared, haveHandlers, dummy, code;
    static const char *const handlerNames[] = {
	"finally", "on", "trap", NULL
    };
    enum Handlers {
	TryFinally, TryOn, TryTrap
    };
    (void)clientData;

    /*
     * Parse the arguments. The handlers are passed to subsequent callbacks as
     * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
     * bindVariables, script), and the finally script is just passed as it is.
     */

4908
4909
4910
4911
4912
4913
4914
4915
4916
4917



4918
4919
4920
4921
4922
4923
4924
4947
4948
4949
4950
4951
4952
4953



4954
4955
4956
4957
4958
4959
4960
4961
4962
4963







-
-
-
+
+
+







    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
    int i, dummy, code, objc;
    int numHandlers = 0;

    handlersObj = data[0];
    finallyObj = data[1];
    objv = data[2];
    handlersObj = (Tcl_Obj *)data[0];
    finallyObj = (Tcl_Obj *)data[1];
    objv = (Tcl_Obj **)data[2];
    objc = PTR2INT(data[3]);

    cmdObj = objv[0];

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.
     */
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132



5133
5134
5135
5136
5137
5138
5139
5162
5163
5164
5165
5166
5167
5168



5169
5170
5171
5172
5173
5174
5175
5176
5177
5178







-
-
-
+
+
+







    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
    Tcl_Obj *finallyObj;
    int finally;

    objv = data[0];
    options = data[1];
    handlerKindObj = data[2];
    objv = (Tcl_Obj **)data[0];
    options = (Tcl_Obj *)data[1];
    handlerKindObj = (Tcl_Obj *)data[2];
    finally = PTR2INT(data[3]);

    cmdObj = objv[0];
    finallyObj = finally ? objv[finally] : 0;

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216



5217
5218
5219
5220
5221
5222
5223
5246
5247
5248
5249
5250
5251
5252



5253
5254
5255
5256
5257
5258
5259
5260
5261
5262







-
-
-
+
+
+







TryPostFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *cmdObj;

    resultObj = data[0];
    options = data[1];
    cmdObj = data[2];
    resultObj = (Tcl_Obj *)data[0];
    options = (Tcl_Obj *)data[1];
    cmdObj = (Tcl_Obj *)data[2];

    /*
     * If the result wasn't OK, we need to adjust the result options.
     */

    if (result != TCL_OK) {
	Tcl_DecrRefCount(resultObj);
5284
5285
5286
5287
5288
5289
5290

5291
5292
5293
5294
5295
5296
5297
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337







+







TclNRWhileObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    ForIterData *iterPtr;
    (void)dummy;

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

    /*

Changes to generic/tclCompCmds.c.

263
264
265
266
267
268
269

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







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex;
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
399
400
401
402
403
404
405
406

407
408

409
410
411
412
413
414
415
400
401
402
403
404
405
406

407
408

409
410
411
412
413
414
415
416







-
+

-
+







    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = ckalloc(sizeof(ForeachInfo));
    infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0] = (ForeachVarList *)ckalloc(sizeof(ForeachVarList) + sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
518
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533


534
535
536
537
538
539
540
519
520
521
522
523
524
525

526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543







-
+








+
+







 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileBreakCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    (void)dummy;
    (void)cmdPtr;

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Find the innermost exception range that contains this command.
588
589
590
591
592
593
594

595
596
597
598
599
600
601
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605







+







    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup jumpFixup;
    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
    int resultIndex, optsIndex, range, dropScript = 0;
    DefineLineInformation;	/* TIP #280 */
    int depth = TclGetStackDepth(envPtr);
    (void)cmdPtr;

    /*
     * If syntax does not match what we expect for [catch], do not compile.
     * Let runtime checks determine if syntax has changed.
     */

    if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
761
762
763
764
765
766
767
768

769
770
771
772
773
774
775


776
777
778
779
780
781
782
765
766
767
768
769
770
771

772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788







-
+







+
+







 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileClockClicksCmd(
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_Interp* dummy,		/* Tcl interpreter */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token* tokenPtr;
    (void)dummy;
    (void)cmdPtr;

    switch (parsePtr->numWords) {
    case 1:
	/*
	 * No args
	 */
	TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr);
825
826
827
828
829
830
831
832

833
834
835
836
837
838


839
840
841
842
843
844
845
831
832
833
834
835
836
837

838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853







-
+






+
+







 *
 * Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds.
 *----------------------------------------------------------------------
 */

int
TclCompileClockReadingCmd(
    Tcl_Interp* interp,		/* Tcl interpreter */
    Tcl_Interp* dummy,		/* Tcl interpreter */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)dummy;

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr);

    return TCL_OK;
872
873
874
875
876
877
878

879
880
881
882
883
884
885
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *objPtr, *listObj;
    Tcl_Token *tokenPtr;
    int i;
    (void)cmdPtr;

    /* TODO: Consider compiling expansion case. */
    if (parsePtr->numWords == 1) {
	/*
	 * [concat] without arguments just pushes an empty object.
	 */

948
949
950
951
952
953
954
955

956
957
958
959
960
961
962
963


964
965
966
967
968
969
970
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981







-
+








+
+







 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileContinueCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    (void)dummy;
    (void)cmdPtr;

    /*
     * There should be no argument after the "continue".
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;
    (void)cmdPtr;

    /*
     * There must be at least one argument after the command.
     */

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157
1158
1159
1160
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * There must be at least three arguments after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 4) {
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
1241
1242
1243
1244







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
1807
1808
1809
1810
1811
1812
1813
1814

1815
1816

1817
1818
1819
1820
1821
1822
1823
1822
1823
1824
1825
1826
1827
1828

1829
1830

1831
1832
1833
1834
1835
1836
1837
1838







-
+

-
+








    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.
     */

    duiPtr = ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr = (DictUpdateInfo *)ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	/*
	 * Put keys to one side for later compilation to bytecode.
	 */

2286
2287
2288
2289
2290
2291
2292
2293

2294
2295

2296
2297

2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316

2317


2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334

2335
2336


2337
2338
2339
2340
2341
2342
2343
2301
2302
2303
2304
2305
2306
2307

2308
2309

2310
2311

2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330

2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350

2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362







-
+

-
+

-
+


















-
+

+
+
















-
+


+
+







 */

static ClientData
DupDictUpdateInfo(
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    unsigned len;
    size_t len;

    dui1Ptr = clientData;
    dui1Ptr = (DictUpdateInfo *)clientData;
    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
    dui2Ptr = ckalloc(len);
    dui2Ptr = (DictUpdateInfo *)ckalloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    ckfree(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    int i;
    (void)codePtr;
    (void)pcOffset;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
    }
}

static void
DisassembleDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = clientData;
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    int i;
    Tcl_Obj *variables = Tcl_NewObj();
    (void)codePtr;
    (void)pcOffset;

    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewIntObj(duiPtr->varIndices[i]));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
	    variables);
2372
2373
2374
2375
2376
2377
2378

2379
2380
2381
2382
2383
2384
2385
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405







+







{
    /*
     * General syntax: [error message ?errorInfo? ?errorCode?]
     */

    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }

    /*
     * Handle the message.
2441
2442
2443
2444
2445
2446
2447

2448
2449
2450
2451
2452
2453
2454
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475







+







    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;
    (void)cmdPtr;

    if (parsePtr->numWords == 1) {
	return TCL_ERROR;
    }

    /*
     * TIP #280: Use the per-word line information of the current command.
2490
2491
2492
2493
2494
2495
2496

2497
2498
2499
2500
2501
2502
2503
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525







+







    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int bodyCodeOffset, nextCodeOffset, jumpDist;
    int bodyRange, nextRange;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 5) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the for
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744







+







				 * record in the ByteCode. */

    Tcl_Token *tokenPtr, *bodyTokenPtr;
    int jumpBackOffset, infoIndex, range;
    int numWords, numLists, i, j, code = TCL_OK;
    Tcl_Obj *varListObj = NULL;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */

    if (procPtr == NULL) {
2743
2744
2745
2746
2747
2748
2749
2750

2751
2752
2753
2754
2755
2756
2757
2766
2767
2768
2769
2770
2771
2772

2773
2774
2775
2776
2777
2778
2779
2780







-
+







    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    numLists = (numWords - 2)/2;
    infoPtr = ckalloc(sizeof(ForeachInfo)
    infoPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
	    + (numLists - 1) * sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Parse each var list into sequence of var names.  Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
2777
2778
2779
2780
2781
2782
2783
2784

2785
2786
2787
2788
2789
2790
2791
2800
2801
2802
2803
2804
2805
2806

2807
2808
2809
2810
2811
2812
2813
2814







-
+







	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = ckalloc(sizeof(ForeachVarList)
	varListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
		+ (numVars - 1) * sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
2908
2909
2910
2911
2912
2913
2914
2915

2916
2917
2918
2919
2920

2921
2922
2923
2924
2925
2926
2927
2928
2929

2930
2931
2932
2933
2934
2935
2936
2931
2932
2933
2934
2935
2936
2937

2938
2939
2940
2941
2942

2943
2944
2945
2946
2947
2948
2949
2950
2951

2952
2953
2954
2955
2956
2957
2958
2959







-
+




-
+








-
+







 */

static ClientData
DupForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = clientData;
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = ckalloc(sizeof(ForeachInfo)
    dupPtr = (ForeachInfo *)ckalloc(sizeof(ForeachInfo)
	    + numLists * sizeof(ForeachVarList *));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = ckalloc(sizeof(ForeachVarList)
	dupListPtr = (ForeachVarList *)ckalloc(sizeof(ForeachVarList)
		+ numVars * sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }
2957
2958
2959
2960
2961
2962
2963
2964

2965
2966
2967
2968
2969
2970
2971
2980
2981
2982
2983
2984
2985
2986

2987
2988
2989
2990
2991
2992
2993
2994







-
+







 */

static void
FreeForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to free. */
{
    ForeachInfo *infoPtr = clientData;
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	ckfree(listPtr);
2993
2994
2995
2996
2997
2998
2999
3000

3001
3002


3003
3004
3005
3006
3007
3008
3009
3016
3017
3018
3019
3020
3021
3022

3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034







-
+


+
+







static void
PrintForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = clientData;
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    (void)codePtr;
    (void)pcOffset;

    Tcl_AppendToObj(appendObj, "data=[", -1);

    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
3033
3034
3035
3036
3037
3038
3039
3040

3041
3042


3043
3044
3045
3046
3047
3048
3049
3058
3059
3060
3061
3062
3063
3064

3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076







-
+


+
+







static void
PrintNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = clientData;
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    (void)codePtr;
    (void)pcOffset;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);
	}
3063
3064
3065
3066
3067
3068
3069
3070

3071
3072
3073


3074
3075
3076
3077
3078
3079
3080
3090
3091
3092
3093
3094
3095
3096

3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109







-
+



+
+







static void
DisassembleForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = clientData;
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;
    (void)codePtr;
    (void)pcOffset;

    /*
     * Data stores.
     */

    objPtr = Tcl_NewObj();
    for (i=0 ; i<infoPtr->numLists ; i++) {
3110
3111
3112
3113
3114
3115
3116
3117

3118
3119
3120


3121
3122
3123
3124
3125
3126
3127
3139
3140
3141
3142
3143
3144
3145

3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158







-
+



+
+







static void
DisassembleNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = clientData;
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;
    (void)codePtr;
    (void)pcOffset;

    /*
     * Jump offset.
     */

    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
	   Tcl_NewIntObj(infoPtr->loopCtTemp));
3172
3173
3174
3175
3176
3177
3178

3179
3180
3181
3182
3183
3184
3185
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217







+







    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    int i, j, len;
    (void)cmdPtr;

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

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
3194
3195
3196
3197
3198
3199
3200
3201

3202
3203
3204
3205
3206
3207
3208
3226
3227
3228
3229
3230
3231
3232

3233
3234
3235
3236
3237
3238
3239
3240







-
+







    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **)ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	objv[i] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}
3488
3489
3490
3491
3492
3493
3494
3495

3496
3497
3498
3499
3500
3501
3502
3520
3521
3522
3523
3524
3525
3526

3527
3528
3529
3530
3531
3532
3533
3534







-
+








	    if (!(flags & TCL_NO_ELEMENT) && elNameLen) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

		elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = elNameLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = 1;
	    }
3543
3544
3545
3546
3547
3548
3549
3550

3551
3552
3553
3554
3555
3556
3557
3575
3576
3577
3578
3579
3580
3581

3582
3583
3584
3585
3586
3587
3588
3589







-
+







	    if (!(flags & TCL_NO_ELEMENT)) {
	      if (remainingLen) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingLen;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

Changes to generic/tclCompCmdsGR.c.

89
90
91
92
93
94
95

96
97
98
99
100
101
102
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

184
185
186
187
188
189
190

191
192
193
194
195
196
197
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199







+







    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
    const char *word;
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * Only compile the "if" command if all arguments are simple words, in
     * order to insure correct substitution [Bug 219166]
     */

    tokenPtr = parsePtr->tokenPtr;
474
475
476
477
478
479
480

481
482
483
484
485
486
487
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *incrTokenPtr;
    int isScalar, localIndex, haveImmValue, immValue;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
	return TCL_ERROR;
    }

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

636
637
638
639
640
641
642
643

644
645
646
647
648
649


650
651
652
653
654
655
656
639
640
641
642
643
644
645

646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661







-
+






+
+







  notCompilable:
    Tcl_DecrRefCount(objPtr);
    return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileInfoCoroutineCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)dummy;
    (void)cmdPtr;
    /*
     * Only compile [info coroutine] without arguments.
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }
671
672
673
674
675
676
677

678
679
680
681
682
683
684
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int isScalar, localIndex;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
717
718
719
720
721
722
723

724
725
726
727
728
729
730
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737







+







    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)cmdPtr;
    /*
     * Only compile [info level] without arguments or with a single argument.
     */

    if (parsePtr->numWords == 1) {
	/*
	 * Not much to do; we compile to a single instruction...
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
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







+




















+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitOpcode(		INST_TCLOO_CLASS,	envPtr);
    return TCL_OK;
}

int
TclCompileInfoObjectIsACmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    (void)cmdPtr;

    /*
     * We only handle [info object isa object <somevalue>]. The first three
     * words are compressed to a single token by the ensemble compilation
     * engine.
     */

810
811
812
813
814
815
816

817
818
819
820
821
822
823
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitOpcode(		INST_TCLOO_NS,		envPtr);
    return TCL_OK;
849
850
851
852
853
854
855

856
857
858
859
860
861
862
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

965
966
967
968
969
970
971

972
973
974
975
976
977
978
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int isScalar, localIndex, numWords, idx;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    numWords = parsePtr->numWords;

    /*
     * Check for command syntax error, but we'll punt that to runtime.
     */

1069
1070
1071
1072
1073
1074
1075

1076
1077
1078
1079
1080
1081
1082
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, idx, numWords = parsePtr->numWords;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * Quit if too few args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171
1172
1173
1174
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *valueTokenPtr;
    int i, numWords, concat, build;
    Tcl_Obj *listObj, *objPtr;
    (void)cmdPtr;

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushStringLiteral(envPtr, "");
1273
1274
1275
1276
1277
1278
1279

1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
1307
1308
1309
1310
1311
1312
1313

1314
1315
1316
1317
1318
1319
1320
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx1, idx2;
    (void)cmdPtr;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
1368
1369
1370
1371
1372
1373
1374

1375
1376
1377
1378
1379
1380
1381
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx, i;
    (void)cmdPtr;

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481
1482
1483
1484
1485
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx1, idx2, i;
    int emptyPrefix=1, suffixStart = 0;
    (void)cmdPtr;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
1640
1641
1642
1643
1644
1645
1646

1647
1648
1649
1650
1651
1652
1653
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672







+







				 * code burst. */
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the variable name. */
    int localIndex;		/* Index of var in local var table. */
    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
    int i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * Check argument count.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
1772
1773
1774
1775
1776
1777
1778
1779

1780
1781
1782
1783
1784
1785


1786
1787
1788
1789
1790
1791
1792
1791
1792
1793
1794
1795
1796
1797

1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813







-
+






+
+







 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileNamespaceCurrentCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)dummy;
    (void)cmdPtr;
    /*
     * Only compile [namespace current] without arguments.
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }
1806
1807
1808
1809
1810
1811
1812

1813
1814
1815
1816
1817
1818
1819
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
1856
1857
1858
1859
1860
1861
1862

1863
1864
1865
1866
1867
1868
1869
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr,	tokenPtr,			interp, 1);
1879
1880
1881
1882
1883
1884
1885

1886
1887
1888
1889
1890
1891
1892
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    DefineLineInformation;	/* TIP #280 */
    int off;
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushStringLiteral(envPtr, "0");
1915
1916
1917
1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    DefineLineInformation;	/* TIP #280 */
    JumpFixup jumpFixup;
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * Take care; only add 2 to found index if the string was actually found.
1952
1953
1954
1955
1956
1957
1958

1959
1960
1961
1962
1963
1964
1965
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Only compile [namespace upvar ...]: needs an even number of args, >=4
2013
2014
2015
2016
2017
2018
2019

2020
2021
2022
2023
2024
2025
2026
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *opt;
    int idx;
    (void)cmdPtr;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    idx = 1;

2079
2080
2081
2082
2083
2084
2085

2086
2087
2088
2089
2090
2091
2092
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120







+







    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the RE or string. */
    int i, len, nocase, exact, sawLast, simple;
    const char *str;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * We are only interested in compiling simple regexp cases. Currently
     * supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var
     *   regexp ?-nocase? ?--? {^staticString$} $var
     */
2265
2266
2267
2268
2269
2270
2271

2272
2273
2274
2275
2276
2277
2278
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307







+








    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *stringTokenPtr;
    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
    Tcl_DString pattern;
    const char *bytes;
    int len, exact, quantified, result = TCL_ERROR;
    (void)cmdPtr;

    if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
	return TCL_ERROR;
    }

    /*
     * Parse the "-all", which must be the first argument (other options not
2425
2426
2427
2428
2429
2430
2431

2432
2433
2434
2435
2436
2437
2438
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468







+







    int level, code, objc, size, status = TCL_OK;
    int numWords = parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /*
     * Check for special case which can always be compiled:
     *	    return -options <opts> <msg>
     * Unlike the normal [return] compilation, this version does everything at
     * runtime so it can handle arbitrary words and not just literals. Note
     * that if INST_RETURN_STK wasn't already needed for something else
2451
2452
2453
2454
2455
2456
2457
2458

2459
2460
2461
2462
2463
2464
2465
2481
2482
2483
2484
2485
2486
2487

2488
2489
2490
2491
2492
2493
2494
2495







-
+







	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **)TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     *
     * TODO: There is potential for improvement if all option keys are known
2670
2671
2672
2673
2674
2675
2676

2677
2678
2679
2680
2681
2682
2683
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *objPtr;
    (void)cmdPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords < 3) {
2776
2777
2778
2779
2780
2781
2782

2783
2784
2785
2786
2787
2788
2789
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
2851
2852
2853
2854
2855
2856
2857
2858

2859
2860
2861
2862
2863
2864
2865
2866

2867
2868
2869
2870
2871
2872
2873
2883
2884
2885
2886
2887
2888
2889

2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906







-
+








+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
IndexTailVarIfKnown(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *tailPtr;
    const char *tailName, *p;
    int len, n = varTokenPtr->numComponents;
    Tcl_Token *lastTokenPtr;
    int full, localIndex;
    (void)dummy;

    /*
     * Determine if the tail is (a) known at compile time, and (b) not an
     * array element. Should any of these fail, return an error so that the
     * non-compiled command will be called at runtime.
     *
     * In order for the tail to be known at compile time, the last token in
2950
2951
2952
2953
2954
2955
2956

2957
2958
2959
2960
2961
2962
2963
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;
    (void)cmdPtr;

    if (parsePtr->numWords > 255) {
	return TCL_ERROR;
    }

    for (i=0 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
2975
2976
2977
2978
2979
2980
2981

2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997

2998
2999
3000
3001
3002
3003


3004
3005
3006
3007
3008
3009
3010
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031

3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047







+















-
+






+
+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;
    (void)cmdPtr;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
	return TCL_ERROR;
    }

    for (i=0 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);
    return TCL_OK;
}

int
TclCompileObjectSelfCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)dummy;
    (void)cmdPtr;
    /*
     * We only handle [self] and [self object] (which is the same operation).
     * These are the only very common operations on [self] for which
     * bytecoding is at all reasonable.
     */

    if (parsePtr->numWords == 1) {

Changes to generic/tclCompCmdsSZ.c.

41
42
43
44
45
46
47
48
49


50
51
52
53
54



55
56
57
58
59
60
61
41
42
43
44
45
46
47


48
49

50



51
52
53
54
55
56
57
58
59
60







-
-
+
+
-

-
-
-
+
+
+







			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileUnaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static void		IssueSwitchChainedTests(Tcl_Interp *interp,
			    CompileEnv *envPtr, int mode, int noCase,
			    int valueIndex, int numWords,
			    Tcl_Token **bodyToken, int *bodyLines,
			    int numWords, Tcl_Token **bodyToken,
				int *bodyLines, int **bodyNext);
			    int **bodyNext);
static void		IssueSwitchJumpTable(Tcl_Interp *interp,
			    CompileEnv *envPtr, int valueIndex,
			    int numWords, Tcl_Token **bodyToken,
			    int *bodyLines, int **bodyContLines);
			    CompileEnv *envPtr, int numWords,
				Tcl_Token **bodyToken, int *bodyLines,
				int **bodyContLines);
static int		IssueTryClausesInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    int numHandlers, int *matchCodes,
			    Tcl_Obj **matchClauses, int *resultVarIndices,
			    int *optionVarIndices, Tcl_Token **handlerTokens);
static int		IssueTryClausesFinallyInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
134
135
136
137
138
139
140

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







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isAssignment, isScalar, localIndex, numWords;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    numWords = parsePtr->numWords;
    if ((numWords != 2) && (numWords != 3)) {
	return TCL_ERROR;
    }
    isAssignment = (numWords == 3);

229
230
231
232
233
234
235

236
237
238
239
240
241
242
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243







+







				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int i, numWords = parsePtr->numWords, numArgs;
    Tcl_Token *wordTokenPtr;
    Tcl_Obj *obj, *folded;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    /* Trivial case, no arg */

    if (numWords<2) {
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    }
299
300
301
302
303
304
305

306
307
308
309
310
311
312
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
331
332
333
334
335
336
337

338
339
340
341
342
343
344
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
363
364
365
366
367
368
369

370
371
372
373
374
375
376
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
395
396
397
398
399
400
401

402
403
404
405
406
407
408
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
427
428
429
430
431
432
433

434
435
436
437
438
439
440
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the index operation.
456
457
458
459
460
461
462

463
464
465
466
467
468
469
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int idx;
    (void)cmdPtr;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /* Compute and push the string in which to insert */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
882
883
884
885
886
887
888

889
890
891
892
893
894
895
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    Tcl_Obj *objPtr;
    (void)cmdPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(objPtr);
985
986
987
988
989
990
991

992
993
994
995
996
997
998
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
    int idx1, idx2;
    (void)cmdPtr;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
    fromTokenPtr = TokenAfter(stringTokenPtr);
    toTokenPtr = TokenAfter(fromTokenPtr);
1061
1062
1063
1064
1065
1066
1067

1068
1069
1070
1071
1072
1073
1074
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *valueTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int first, last;
    (void)cmdPtr;

    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
	return TCL_ERROR;
    }

    /* Bytecode to compute/push string argument being replaced */
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268
1269
1270
1271
1272
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
1287
1288
1289
1290
1291
1292
1293

1294
1295
1296
1297
1298
1299
1300
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    (void)cmdPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481

1482
1483
1484
1485
1486
1487
1488
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502







+





-
+







    int numArgs = parsePtr->numWords - 1;
    int numOpts = numArgs - 1;
    int objc, flags = TCL_SUBST_ALL;
    Tcl_Obj **objv/*, *toSubst = NULL*/;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    int code = TCL_ERROR;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (numArgs == 0) {
	return TCL_ERROR;
    }

    objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **)TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));

    for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    goto cleanup;
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841







+







    int **bodyContLines;	/* Array of continuation line info. */
    int noCase;			/* Has the -nocase flag been given? */
    int foundMode = 0;		/* Have we seen a mode flag yet? */
    int i, valueIndex;
    int result = TCL_ERROR;
    DefineLineInformation;	/* TIP #280 */
    int *clNext = envPtr->clNext;
    (void)cmdPtr;

    /*
     * Only handle the following versions:
     *   switch         ?--? word {pattern body ...}
     *   switch -exact  ?--? word {pattern body ...}
     *   switch -glob   ?--? word {pattern body ...}
     *   switch -regexp ?--? word {pattern body ...}
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977




1978
1979
1980
1981
1982
1983
1984
1982
1983
1984
1985
1986
1987
1988




1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999







-
-
-
-
+
+
+
+







	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {
	    return TCL_ERROR;
	}
	bodyTokenArray = ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = ckalloc(sizeof(int) * maxLen);
	bodyContLines = ckalloc(sizeof(int*) * maxLen);
	bodyTokenArray = (Tcl_Token *)ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = (int *)ckalloc(sizeof(int) * maxLen);
	bodyContLines = (int **)ckalloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038



2039
2040
2041
2042
2043
2044
2045
2044
2045
2046
2047
2048
2049
2050



2051
2052
2053
2054
2055
2056
2057
2058
2059
2060







-
-
-
+
+
+








	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = ckalloc(sizeof(int) * numWords);
	bodyContLines = ckalloc(sizeof(int*) * numWords);
	bodyToken = (Tcl_Token **)ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = (int *)ckalloc(sizeof(int) * numWords);
	bodyContLines = (int **)ckalloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087

2088
2089
2090
2091
2092
2093
2094
2092
2093
2094
2095
2096
2097
2098

2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
2109







-
+


-
+







     * but it handles the most common case well enough.
     */

    /* Both methods push the value to match against onto the stack. */
    CompileWord(envPtr, valueTokenPtr, interp, valueIndex);

    if (mode == Switch_Exact) {
	IssueSwitchJumpTable(interp, envPtr, valueIndex, numWords, bodyToken,
	IssueSwitchJumpTable(interp, envPtr, numWords, bodyToken,
		bodyLines, bodyContLines);
    } else {
	IssueSwitchChainedTests(interp, envPtr, mode, noCase, valueIndex,
	IssueSwitchChainedTests(interp, envPtr, mode, noCase,
		numWords, bodyToken, bodyLines, bodyContLines);
    }
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.
     */
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







-








static void
IssueSwitchChainedTests(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int mode,			/* Exact, Glob or Regexp */
    int noCase,			/* Case-insensitivity flag. */
    int valueIndex,		/* The value to match against. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    int *bodyLines,		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
2151
2152
2153
2154
2155
2156
2157
2158
2159


2160
2161
2162
2163
2164
2165
2166
2165
2166
2167
2168
2169
2170
2171


2172
2173
2174
2175
2176
2177
2178
2179
2180







-
-
+
+








    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    contFixCount = 0;
    fixupArray = TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = TclStackAlloc(interp, sizeof(int) * numBodyTokens);
    fixupArray = (JumpFixup *)TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = (unsigned int *)TclStackAlloc(interp, sizeof(int) * numBodyTokens);
    memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<numBodyTokens ; i+=2) {
	nextArmFixupIndex = -1;
	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2384
2385
2386
2387
2388
2389
2390

2391
2392
2393
2394
2395
2396
2397







-







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

static void
IssueSwitchJumpTable(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int valueIndex,		/* The value to match against. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    int *bodyLines,		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
2395
2396
2397
2398
2399
2400
2401
2402

2403
2404
2405

2406
2407
2408
2409
2410
2411
2412
2408
2409
2410
2411
2412
2413
2414

2415
2416
2417

2418
2419
2420
2421
2422
2423
2424
2425







-
+


-
+







     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = ckalloc(sizeof(JumptableInfo));
    jtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty). Note that
2566
2567
2568
2569
2570
2571
2572
2573
2574


2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593

2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606

2607
2608
2609
2610

2611
2612
2613
2614

2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635

2636
2637
2638
2639
2640


2641
2642
2643
2644

2645
2646
2647
2648
2649
2650
2651
2579
2580
2581
2582
2583
2584
2585


2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605

2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618

2619
2620
2621
2622
2623
2624
2625
2626
2627

2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648

2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659

2660
2661
2662
2663
2664
2665
2666
2667







-
-
+
+


















-
+












-
+




+



-
+




















-
+





+
+



-
+







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

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *newJtPtr = ckalloc(sizeof(JumptableInfo));
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    JumptableInfo *newJtPtr = (JumptableInfo *)ckalloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {
	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
    }
    return newJtPtr;
}

static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    ckfree(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset, i = 0;
    (void)codePtr;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));

	if (i++) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	    if (i%4==0) {
		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
	    }
	}
	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
		keyPtr, pcOffset + offset);
    }
}

static void
DisassembleJumptableInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_Obj *mapping = Tcl_NewObj();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset;
    (void)codePtr;
    (void)pcOffset;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));
	Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
		Tcl_NewIntObj(offset));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
}

2675
2676
2677
2678
2679
2680
2681

2682
2683
2684
2685
2686
2687
2688
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;
    (void)cmdPtr;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* make room for the nsObjPtr */
2724
2725
2726
2727
2728
2729
2730

2731
2732
2733
2734
2735
2736
2737
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755







+







    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int numWords = parsePtr->numWords;
    Tcl_Token *codeToken, *msgToken;
    Tcl_Obj *objPtr;
    int codeKnown, codeIsList, codeIsValid, len;
    (void)cmdPtr;

    if (numWords != 3) {
	return TCL_ERROR;
    }
    codeToken = TokenAfter(parsePtr->tokenPtr);
    msgToken = TokenAfter(codeToken);

2829
2830
2831
2832
2833
2834
2835

2836
2837
2838
2839
2840
2841
2842
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861







+







{
    int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR;
    Tcl_Token *bodyToken, *finallyToken, *tokenPtr;
    Tcl_Token **handlerTokens = NULL;
    Tcl_Obj **matchClauses = NULL;
    int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL;
    int i;
    (void)cmdPtr;

    if (numWords < 2) {
	return TCL_ERROR;
    }

    bodyToken = TokenAfter(parsePtr->tokenPtr);

2856
2857
2858
2859
2860
2861
2862
2863
2864


2865
2866
2867
2868



2869
2870
2871
2872
2873
2874
2875
2875
2876
2877
2878
2879
2880
2881


2882
2883
2884



2885
2886
2887
2888
2889
2890
2891
2892
2893
2894







-
-
+
+

-
-
-
+
+
+







    /*
     * Extract information about what handlers there are.
     */

    numHandlers = numWords >> 2;
    numWords -= numHandlers * 4;
    if (numHandlers > 0) {
	handlerTokens = TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
	matchClauses = TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
	handlerTokens = (Tcl_Token**)TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
	matchClauses = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = TclStackAlloc(interp, sizeof(int) * numHandlers);
	matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    int objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131



3132
3133
3134
3135
3136
3137
3138
3141
3142
3143
3144
3145
3146
3147



3148
3149
3150
3151
3152
3153
3154
3155
3156
3157







-
-
-
+
+
+







    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     * For us to be here, there must be at least one handler.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = TclStackAlloc(interp, sizeof(int)*numHandlers);
    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	noError[i] = -1;
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
3333
3334
3335
3336
3337
3338
3339
3340
3341


3342
3343
3344
3345
3346
3347
3348
3352
3353
3354
3355
3356
3357
3358


3359
3360
3361
3362
3363
3364
3365
3366
3367







-
-
+
+








    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = TclStackAlloc(interp, sizeof(int)*numHandlers);
    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	int noTrapError, trapError;
	const char *p;

	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
3636
3637
3638
3639
3640
3641
3642

3643
3644
3645
3646
3647
3648
3649
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

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

    /*
     * Verify that all words - except the first non-option one - are known at
     * compile time so that we can handle them without needing to do a nasty
     * push/rotate. [Bug 3970f54c4e]
3778
3779
3780
3781
3782
3783
3784

3785
3786
3787
3788
3789
3790
3791
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812







+







    Tcl_Token *testTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
    int loopMayEnd = 1;		/* This is set to 0 if it is recognized as an
				 * infinite loop. */
    Tcl_Obj *boolObj;
    DefineLineInformation;	/* TIP #280 */
    (void)cmdPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the while
3949
3950
3951
3952
3953
3954
3955


3956
3957
3958
3959
3960
3961
3962
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985







+
+







    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    (void)cmdPtr;

    if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
	return TCL_ERROR;
    }

    if (parsePtr->numWords == 1) {
	PUSH("");
    } else {
3995
3996
3997
3998
3999
4000
4001

4002
4003
4004
4005
4006
4007
4008
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int i;
    (void)cmdPtr;

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    OP(		NS_CURRENT);
    for (i = 1 ; i < parsePtr->numWords ; i++) {
4242
4243
4244
4245
4246
4247
4248

4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259

4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270

4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282

4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294

4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306

4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318

4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338

4339
4340
4341
4342
4343
4344
4345
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377







+











+











+












+












+












+












+




















+







TclCompileInvertOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
}

int
TclCompileNotOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
}

int
TclCompileAddOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
	    envPtr);
}

int
TclCompileMulOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
	    envPtr);
}

int
TclCompileAndOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
	    envPtr);
}

int
TclCompileOrOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
	    envPtr);
}

int
TclCompileXorOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
	    envPtr);
}

int
TclCompilePowOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    /*
     * This one has its own implementation because the ** operator is the only
     * one with right associativity.
     */

    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;
    (void)cmdPtr;

    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PUSH("1");
4355
4356
4357
4358
4359
4360
4361

4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372

4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383

4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394

4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405

4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416

4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427

4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
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
4492
4493
4494

4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505

4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516

4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527

4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538

4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552

4553
4554
4555
4556
4557
4558
4559
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
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
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609







+











+











+











+











+











+











+












+











+











+











+











+











+











+











+











+











+














+







TclCompileLshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
}

int
TclCompileRshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
}

int
TclCompileModOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
}

int
TclCompileNeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
}

int
TclCompileStrneqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
}

int
TclCompileInOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
}

int
TclCompileNiOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
	    envPtr);
}

int
TclCompileLessOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
}

int
TclCompileLeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
}

int
TclCompileGreaterOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
}

int
TclCompileGeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
}

int
TclCompileEqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
}

int
TclCompileStreqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
}

int
TclCompileStrLtOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LT, envPtr);
}

int
TclCompileStrLeOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LE, envPtr);
}

int
TclCompileStrGtOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GT, envPtr);
}

int
TclCompileStrGeOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    (void)cmdPtr;
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GE, envPtr);
}

int
TclCompileMinusOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;
    (void)cmdPtr;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

4592
4593
4594
4595
4596
4597
4598

4599
4600
4601
4602
4603
4604
4605
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656







+







    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;
    (void)cmdPtr;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

Changes to generic/tclCompExpr.c.

627
628
629
630
631
632
633
634

635
636
637
638
639
640
641
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641







-
+







				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = attemptckalloc(nodesAvailable * sizeof(OpNode));
    nodes = (OpNode *)attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*
671
672
673
674
675
676
677
678

679
680
681
682
683
684
685
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685







-
+








	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = attemptckrealloc(nodes, size * sizeof(OpNode));
		newPtr = (OpNode *)attemptckrealloc(nodes, size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		errCode = "NOMEM";
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
915
916
917
918
919
920
921

922
923
924
925
926
927
928
929







-
+







		    errCode = "BADCHAR";
		    goto error;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT: {
		Tcl_Parse *nestedPtr =
		Tcl_Parse *nestedPtr = (Tcl_Parse *)
			TclStackAlloc(interp, sizeof(Tcl_Parse));

		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->start = start;
		tokenPtr->numComponents = 0;

1834
1835
1836
1837
1838
1839
1840
1841

1842
1843
1844
1845
1846
1847
1848
1834
1835
1836
1837
1838
1839
1840

1841
1842
1843
1844
1845
1846
1847
1848







-
+







				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals. */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */

    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
2152
2153
2154
2155
2156
2157
2158
2159

2160
2161
2162
2163
2164
2165
2166
2152
2153
2154
2155
2156
2157
2158

2159
2160
2161
2162
2163
2164
2165
2166







-
+







    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */

    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {
	/*
2222
2223
2224
2225
2226
2227
2228
2229

2230
2231
2232
2233
2234
2235
2236
2222
2223
2224
2225
2226
2227
2228

2229
2230
2231
2232
2233
2234
2235
2236







-
+








    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = TclStackAlloc(interp, sizeof(CompileEnv));
    envPtr = (CompileEnv *)TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    byteCodePtr = TclInitByteCode(envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
2317
2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330

2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343

2344
2345
2346
2347
2348
2349
2350
2317
2318
2319
2320
2321
2322
2323

2324
2325
2326
2327
2328
2329

2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342

2343
2344
2345
2346
2347
2348
2349
2350







-
+





-
+












-
+







		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		break;
	    case COLON:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->jump);
		TclAdjustStackDepth(-1, envPtr);
		if (convert) {
		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
		}
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = TclStackAlloc(interp, sizeof(JumpList));
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
		break;
	    }
	} else {
2569
2570
2571
2572
2573
2574
2575
2576

2577
2578
2579
2580
2581
2582
2583
2569
2570
2571
2572
2573
2574
2575

2576
2577
2578
2579
2580
2581
2582
2583







-
+







int
TclSingleOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = clientData;
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    OpNode nodes[2];
    Tcl_Obj *const *litObjv = objv + 1;

    if (objc != 1 + occdPtr->i.numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
2627
2628
2629
2630
2631
2632
2633
2634
2635


2636
2637

2638
2639
2640
2641
2642
2643
2644
2627
2628
2629
2630
2631
2632
2633


2634
2635
2636

2637
2638
2639
2640
2641
2642
2643
2644







-
-
+
+

-
+







    Tcl_Obj *const objv[])
{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = clientData;
	Tcl_Obj **litObjv = TclStackAlloc(interp,
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
	Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
		2 * (objc-2) * sizeof(Tcl_Obj *));
	OpNode *nodes = TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
	OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
	unsigned char lexeme;
	int i, lastAnd = 1;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);

	litObjv[0] = objv[1];
2702
2703
2704
2705
2706
2707
2708
2709

2710
2711
2712
2713
2714
2715
2716
2702
2703
2704
2705
2706
2707
2708

2709
2710
2711
2712
2713
2714
2715
2716







-
+







int
TclVariadicOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = clientData;
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    int code;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
	return TCL_OK;
    }
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2757
2758
2759
2760
2761
2762
2763

2764
2765
2766
2767
2768
2769
2770
2771







-
+








	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	Tcl_Obj *const *litObjv = objv + 1;
	OpNode *nodes = TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
	OpNode *nodes = (OpNode *)TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
	int i, lastOp = OT_LITERAL;

	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	if (lexeme == EXPON) {
	    for (i=objc-2; i>0; i--) {
		nodes[i].lexeme = lexeme;
2821
2822
2823
2824
2825
2826
2827
2828

2829
2830
2831
2832
2833
2834
2835
2821
2822
2823
2824
2825
2826
2827

2828
2829
2830
2831
2832
2833
2834
2835







-
+







int
TclNoIdentOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = clientData;
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }
    return TclVariadicOpCmd(clientData, interp, objc, objv);
}

Changes to generic/tclCompile.c.

708
709
710
711
712
713
714
715

716
717
718
719
720
721
722
708
709
710
711
712
713
714

715
716
717
718
719
720
721
722







-
+







static void		StartExpanding(CompileEnv *envPtr);

/*
 * TIP #280: Helper for building the per-word line information of all compiled
 * commands.
 */
static void		EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
			    Tcl_Token *tokenPtr, const char *cmd, int len,
			    Tcl_Token *tokenPtr, const char *cmd,
			    int numWords, int line, int *clNext, int **lines,
			    CompileEnv *envPtr);
static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);

/*
 * The structure below defines the bytecode Tcl object type by means of
 * procedures that can be invoked by generic object code.
961
962
963
964
965
966
967


968
969
970
971
972
973
974
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976







+
+







 */

static void
DupByteCodeInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    (void)srcPtr;
    (void)copyPtr;
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeByteCodeInternalRep --
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158
1159
1160







-
+







     */

    if (iPtr) {
	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
		(char *) codePtr);

	if (hePtr) {
	    ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
	    ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr));
	    Tcl_DeleteHashEntry(hePtr);
	}
    }

    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }
1170
1171
1172
1173
1174
1175
1176
1177

1178
1179
1180
1181

1182
1183
1184
1185
1186
1187
1188
1172
1173
1174
1175
1176
1177
1178

1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191







-
+




+







 *	piece of bytecode. Idempotent.
 *
 * ---------------------------------------------------------------------
 */

static int
IsCompactibleCompileEnv(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    CompileEnv *envPtr)
{
    unsigned char *pc;
    int size;
    (void)dummy;

    /*
     * Special: procedures in the '::tcl' namespace (or its children) are
     * considered to be well-behaved and so can have compaction applied even
     * if it would otherwise be invalid.
     */

1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505
1506
1507
1508
1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511







-
+







     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.
     *
     * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
     * non-compiling evaluator
     */

    envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;

    if (invoker == NULL) {
	/*
1550
1551
1552
1553
1554
1555
1556
1557

1558
1559
1560
1561
1562
1563
1564
1553
1554
1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
1567







-
+







	/*
	 * Initialize the compiler using the context, making counting absolute
	 * to that context. Note that the context can be byte code execution.
	 * In that case we have to fill out the missing pieces (line, path,
	 * ...) which may make change the type as well.
	 */

	CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	int pc = 0;

	*ctxPtr = *invoker;
	if (invoker->type == TCL_LOCATION_BC) {
	    /*
	     * Note: Type BC => ctx.data.eval.path    is not used.
	     *			ctx.data.tebc.codePtr is used instead.
2061
2062
2063
2064
2065
2066
2067
2068

2069
2070
2071
2072
2073
2074
2075
2064
2065
2066
2067
2068
2069
2070

2071
2072
2073
2074
2075
2076
2077
2078







-
+







     * The map first contain full per-word line information for use by the
     * compiler. This is later replaced by a reduced form which signals
     * non-literal words, stored in 'wlines'.
     */

    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
	    parsePtr->tokenPtr, parsePtr->commandStart,
	    parsePtr->commandSize, parsePtr->numWords, cmdLine,
	    parsePtr->numWords, cmdLine,
	    clNext, &wlines, envPtr);
    wlineat = eclPtr->nuloc - 1;

    envPtr->line = eclPtr->loc[wlineat].line[0];
    envPtr->clNext = eclPtr->loc[wlineat].next[0];

    /* Do we know the command word? */
2183
2184
2185
2186
2187
2188
2189
2190

2191
2192
2193
2194
2195
2196
2197
2186
2187
2188
2189
2190
2191
2192

2193
2194
2195
2196
2197
2198
2199
2200







-
+








    if (numBytes > 0) {
      /*
       * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
       * many nested compilations (body enclosed in body) can cause abnormal
       * program termination with a stack overflow exception, bug [fec0c17d39].
       */
      Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse));
      Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse));

      do {
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) {
	    /*
	     * Compile bytecodes to report the parsePtr error at runtime.
2441
2442
2443
2444
2445
2446
2447
2448

2449
2450
2451
2452
2453
2454
2455
2444
2445
2446
2447
2448
2449
2450

2451
2452
2453
2454
2455
2456
2457
2458







-
+







	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = ckalloc(maxNumCL * sizeof(int));
	clPosition = (int *)ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
2482
2483
2484
2485
2486
2487
2488
2489

2490
2491
2492
2493
2494
2495
2496
2485
2486
2487
2488
2489
2490
2491

2492
2493
2494
2495
2496
2497
2498
2499







-
+







	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
			clPosition = (int *)ckrealloc(clPosition,
                                maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756







+







				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    (void)cmdPtr;

    tokenPtr = parsePtr->tokenPtr;
    for (i = 1; i < parsePtr->numWords; i++) {
	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
2856
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2860
2861
2862
2863
2864
2865
2866

2867
2868
2869
2870
2871
2872
2873
2874







-
+








    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = ckalloc(structureSize);
    p = (unsigned char *)ckalloc(structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    TclPreserveByteCode(codePtr);
3069
3070
3071
3072
3073
3074
3075
3076

3077
3078
3079
3080
3081
3082
3083
3073
3074
3075
3076
3077
3078
3079

3080
3081
3082
3083
3084
3085
3086
3087







-
+








    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;
3119
3120
3121
3122
3123
3124
3125
3126

3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140

3141
3142
3143
3144
3145
3146
3147

3148
3149
3150
3151
3152
3153
3154
3123
3124
3125
3126
3127
3128
3129

3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143

3144
3145
3146
3147
3148
3149
3150

3151
3152
3153
3154
3155
3156
3157
3158







-
+













-
+






-
+







 */

void
TclExpandCodeArray(
    void *envArgPtr)		/* Points to the CompileEnv whose code array
				 * must be enlarged. */
{
    CompileEnv *envPtr = envArgPtr;
    CompileEnv *envPtr = (CompileEnv *)envArgPtr;
				/* The CompileEnv containing the code array to
				 * be doubled in size. */

    /*
     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
     * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes);
	envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	unsigned char *newPtr = ckalloc(newBytes);
	unsigned char *newPtr = (unsigned char *)ckalloc(newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;
3200
3201
3202
3203
3204
3205
3206
3207

3208
3209
3210
3211
3212
3213
3214

3215
3216
3217
3218
3219
3220
3221
3204
3205
3206
3207
3208
3209
3210

3211
3212
3213
3214
3215
3216
3217

3218
3219
3220
3221
3222
3223
3224
3225







-
+






-
+








	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes);
	    envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a
	     * ckrealloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = ckalloc(newBytes);
	    CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3308
3309
3310
3311
3312
3313
3314

3315
3316
3317
3318
3319
3320
3321







-







EnterCmdWordData(
    ExtCmdLoc *eclPtr,		/* Points to the map environment structure in
				 * which to enter command location
				 * information. */
    int srcOffset,		/* Offset of first char of the command. */
    Tcl_Token *tokenPtr,
    const char *cmd,
    int len,
    int numWords,
    int line,
    int *clNext,
    int **wlines,
    CompileEnv *envPtr)
{
    ECL *ePtr;
3326
3327
3328
3329
3330
3331
3332
3333

3334
3335
3336
3337
3338
3339
3340


3341
3342

3343
3344
3345
3346
3347
3348
3349
3329
3330
3331
3332
3333
3334
3335

3336
3337
3338
3339
3340
3341


3342
3343
3344

3345
3346
3347
3348
3349
3350
3351
3352







-
+





-
-
+
+

-
+







	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
	 */

	size_t currElems = eclPtr->nloc;
	size_t newElems = (currElems ? 2*currElems : 1);
	size_t newBytes = newElems * sizeof(ECL);

	eclPtr->loc = ckrealloc(eclPtr->loc, newBytes);
	eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = ckalloc(numWords * sizeof(int));
    ePtr->next = ckalloc(numWords * sizeof(int *));
    ePtr->line = (int *)ckalloc(numWords * sizeof(int));
    ePtr->next = (int **)ckalloc(numWords * sizeof(int *));
    ePtr->nline = numWords;
    wwlines = ckalloc(numWords * sizeof(int));
    wwlines = (int *)ckalloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);
3404
3405
3406
3407
3408
3409
3410
3411

3412
3413

3414
3415
3416
3417
3418
3419
3420
3421


3422
3423
3424
3425
3426
3427
3428
3407
3408
3409
3410
3411
3412
3413

3414
3415

3416
3417
3418
3419
3420
3421
3422


3423
3424
3425
3426
3427
3428
3429
3430
3431







-
+

-
+






-
-
+
+







	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
	int newElems = 2*envPtr->exceptArrayEnd;
	size_t newBytes = newElems * sizeof(ExceptionRange);
	size_t newBytes2 = newElems * sizeof(ExceptionAux);

	if (envPtr->mallocedExceptArray) {
	    envPtr->exceptArrayPtr =
		    ckrealloc(envPtr->exceptArrayPtr, newBytes);
		    (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
		    (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = ckalloc(newBytes);
	    ExceptionAux *newPtr2 = ckalloc(newBytes2);
	    ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes);
	    ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2);

	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}
3517
3518
3519
3520
3521
3522
3523
3524

3525
3526
3527
3528

3529
3530
3531
3532
3533
3534
3535
3520
3521
3522
3523
3524
3525
3526

3527
3528
3529
3530

3531
3532
3533
3534
3535
3536
3537
3538







-
+



-
+







	Tcl_Panic("trying to add 'break' fixup to full exception range");
    }

    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
	auxPtr->allocBreakTargets *= 2;
	auxPtr->allocBreakTargets += 2;
	if (auxPtr->breakTargets) {
	    auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets,
	    auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void
3543
3544
3545
3546
3547
3548
3549
3550

3551
3552
3553
3554

3555
3556
3557
3558
3559
3560
3561
3546
3547
3548
3549
3550
3551
3552

3553
3554
3555
3556

3557
3558
3559
3560
3561
3562
3563
3564







-
+



-
+







	Tcl_Panic("trying to add 'continue' fixup to full exception range");
    }

    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
	auxPtr->allocContinueTargets *= 2;
	auxPtr->allocContinueTargets += 2;
	if (auxPtr->continueTargets) {
	    auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets,
	    auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
		    (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

3770
3771
3772
3773
3774
3775
3776
3777

3778
3779
3780
3781
3782
3783
3784

3785
3786
3787
3788
3789
3790
3791
3773
3774
3775
3776
3777
3778
3779

3780
3781
3782
3783
3784
3785
3786

3787
3788
3789
3790
3791
3792
3793
3794







-
+






-
+








	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    ckrealloc(envPtr->auxDataArrayPtr, newBytes);
		    (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    AuxData *newPtr = ckalloc(newBytes);
	    AuxData *newPtr = (AuxData *)ckalloc(newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }
3859
3860
3861
3862
3863
3864
3865
3866

3867
3868
3869
3870
3871
3872
3873

3874
3875
3876
3877
3878
3879
3880
3862
3863
3864
3865
3866
3867
3868

3869
3870
3871
3872
3873
3874
3875

3876
3877
3878
3879
3880
3881
3882
3883







-
+






-
+







     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);

    if (fixupArrayPtr->mallocedArray) {
	fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes);
	fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a
	 * ckrealloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = ckalloc(newBytes);
	JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}

Changes to generic/tclConfig.c.

75
76
77
78
79
80
81
82

83
84
85
86

87
88
89
90
91
92
93
75
76
77
78
79
80
81

82
83
84
85

86
87
88
89
90
91
92
93







-
+



-
+







    const Tcl_Config *configuration,	/* Embedded configuration. */
    const char *valEncoding)	/* Name of the encoding used to store the
				 * configuration values, ASCII, thus UTF-8. */
{
    Tcl_Obj *pDB, *pkgDict;
    Tcl_DString cmdName;
    const Tcl_Config *cfg;
    QCCD *cdPtr = ckalloc(sizeof(QCCD));
    QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = ckalloc(strlen(valEncoding)+1);
	cdPtr->encoding = (char *)ckalloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







static int
QueryConfigObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
{
    QCCD *cdPtr = clientData;
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    int n, index;
    static const char *const subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
322
323
324
325
326
327
328

329
330
331
332
333
334
335
336







-
+







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

static void
QueryConfigDelete(
    ClientData clientData)
{
    QCCD *cdPtr = clientData;
    QCCD *cdPtr = (QCCD *)clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	ckfree(cdPtr->encoding);
355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369







-
+







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

static Tcl_Obj *
GetConfigDict(
    Tcl_Interp *interp)
{
    Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
    Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);

    if (pDB == NULL) {
	pDB = Tcl_NewDictObj();
	Tcl_IncrRefCount(pDB);
	Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
    }

388
389
390
391
392
393
394
395

396
397


398
399
400
401
402
403
404
405
406
407
408
388
389
390
391
392
393
394

395
396

397
398
399
400
401
402
403
404
405
406
407
408
409







-
+

-
+
+











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

static void
ConfigDictDeleteProc(
    ClientData clientData,	/* Pointer to Tcl_Obj. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
    Tcl_Interp *dummy)		/* Interpreter being deleted. */
{
    Tcl_Obj *pDB = clientData;
    Tcl_Obj *pDB = (Tcl_Obj *)clientData;
    (void)dummy;

    Tcl_DecrRefCount(pDB);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclDate.c.

2740
2741
2742
2743
2744
2745
2746
2747

2748
2749
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764







-
+









+







	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    void *clientData,	/* Unused */
    void *dummy,	/* Unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of paraneters */
    Tcl_Obj *const *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;
    (void)dummy;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

2854
2855
2856
2857
2858
2859
2860
2861

2862
2863
2864
2865
2866
2867
2868
2855
2856
2857
2858
2859
2860
2861

2862
2863
2864
2865
2866
2867
2868
2869







-
+







	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,

Changes to generic/tclDecls.h.

4054
4055
4056
4057
4058
4059
4060
4061

4062
4063
4064
4065
4066

4067
4068

4069
4070
4071
4072
4073
4074
4075
4054
4055
4056
4057
4058
4059
4060

4061
4062
4063
4064
4065

4066
4067

4068
4069
4070
4071
4072
4073
4074
4075







-
+




-
+

-
+







	} while(0)
#undef Tcl_DiscardResult
#define Tcl_DiscardResult(statePtr) \
	Tcl_DecrRefCount((statePtr)->objResultPtr)
#undef Tcl_SetResult
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    char *__result = result; \
	    const char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    ckfree(__result); \
		    ckfree((char *)__result); \
		} else { \
		    (*__freeProc)(__result); \
		    (*__freeProc)((char *)__result); \
		} \
	    } \
	} while(0)
#endif /* TCL_NO_DEPRECATED */

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
#   if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)

Changes to generic/tclDictObj.c.

175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
175
176
177
178
179
180
181

182
183
184
185
186
187
188
189







-
+







        Tcl_StoreIntRep((objPtr), &tclDictType, &ir);                   \
    } while (0)

#define DictGetIntRep(objPtr, dictRepPtr)				\
    do {                                                                \
        const Tcl_ObjIntRep *irPtr;                                     \
        irPtr = TclFetchIntRep((objPtr), &tclDictType);                \
        (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;          \
        (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;          \
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.
239
240
241
242
243
244
245
246

247

248
249

250
251
252
253
254
255
256
239
240
241
242
243
244
245

246
247
248
249

250
251
252
253
254
255
256
257







-
+

+

-
+







 */

static Tcl_HashEntry *
AllocChainEntry(
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    ChainEntry *cPtr;
    (void)tablePtr;

    cPtr = ckalloc(sizeof(ChainEntry));
    cPtr = (ChainEntry *)ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    cPtr->entry.clientData = NULL;
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}
275
276
277
278
279
280
281
282

283
284
285
286
287
288
289
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290







-
+







static inline void
DeleteChainTable(
    Dict *dict)
{
    ChainEntry *cPtr;

    for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }
    Tcl_DeleteHashTable(&dict->table);
}

static inline Tcl_HashEntry *
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
323
324
325
326
327
328
329

330
331
332
333
334
335
336
337







-
+







{
    ChainEntry *cPtr = (ChainEntry *)
	    Tcl_FindHashEntry(&dict->table, keyPtr);

    if (cPtr == NULL) {
	return 0;
    } else {
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }

    /*
     * Unstitch from the chain.
     */
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
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







-
+










-
-
+
+







 */

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict, *newDict = ckalloc(sizeof(Dict));
    Dict *oldDict, *newDict = (Dict *)ckalloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetIntRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);
    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
	Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	int n;
	Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);

	/*
	 * Fill in the contents.
	 */

532
533
534
535
536
537
538
539

540
541
542
543
544
545
546
547
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

583
584
585
586
587
588
589
533
534
535
536
537
538
539

540
541
542
543
544
545
546
547
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

583
584
585
586
587
588
589
590







-
+








-
+







-
+



















-
+





-
+







    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = ckalloc(numElems);
	flagPtr = (char *)ckalloc(numElems);
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);

    if (flagPtr != localFlags) {
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629







-
+







static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = ckalloc(sizeof(Dict));
    Dict *dict = (Dict *)ckalloc(sizeof(Dict));

    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
639
640
641
642
643
644
645
646

647
648
649
650
651
652
653
640
641
642
643
644
645
646

647
648
649
650
651
652
653
654







-
+







	}

	for (i=0 ; i<objc ; i+=2) {

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		/*
		 * Not really a well-formed dictionary as there are duplicate
		 * keys, so better get the string rep here so that we can
		 * convert back.
		 */

712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
713
714
715
716
717
718
719

720
721
722
723
724
725
726
727







-
+







		(void)Tcl_InitStringRep(valuePtr, NULL,
			TclCopyAndCollapse(elemSize, elemStart, dst));
	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

		TclDecrRefCount(keyPtr);
		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, valuePtr);
	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
	}
847
848
849
850
851
852
853
854

855
856
857
858
859
860
861
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862







-
+







	     */

	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
	    tmpObj = Tcl_NewDictObj();
	    Tcl_IncrRefCount(tmpObj);
	    Tcl_SetHashValue(hPtr, tmpObj);
	} else {
	    tmpObj = Tcl_GetHashValue(hPtr);
	    tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	    DictGetIntRep(tmpObj, newDict);

	    if (newDict == NULL) {
		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
		    return NULL;
		}
968
969
970
971
972
973
974
975

976
977
978
979
980
981
982
969
970
971
972
973
974
975

976
977
978
979
980
981
982
983







-
+







    TclInvalidateStringRep(dictPtr);
    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
    dict->refCount++;
    TclFreeIntRep(dictPtr)
    DictSetIntRep(dictPtr, dict);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    dict->epoch++;
    return TCL_OK;
}
1017
1018
1019
1020
1021
1022
1023
1024

1025
1026
1027
1028
1029
1030
1031
1018
1019
1020
1021
1022
1023
1024

1025
1026
1027
1028
1029
1030
1031
1032







-
+







	return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
    if (hPtr == NULL) {
	*valuePtrPtr = NULL;
    } else {
	*valuePtrPtr = Tcl_GetHashValue(hPtr);
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1158
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168

1169
1170
1171
1172
1173
1174
1175
1176







-
+


-
+







    } else {
	*donePtr = 0;
	searchPtr->dictionaryPtr = (Tcl_Dict) dict;
	searchPtr->epoch = dict->epoch;
	searchPtr->next = cPtr->nextPtr;
	dict->refCount++;
	if (keyPtrPtr != NULL) {
	    *keyPtrPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
	    *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	}
	if (valuePtrPtr != NULL) {
	    *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
	    *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1224
1225
1226
1227
1228
1229
1230
1231

1232
1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1225
1226
1227
1228
1229
1230
1231

1232
1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245

1246
1247
1248
1249
1250
1251
1252
1253







-
+









-
+



-
+







     * removed. This *shouldn't* happen, but...
     */

    if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
	Tcl_Panic("concurrent dictionary modification and search");
    }

    cPtr = searchPtr->next;
    cPtr = (ChainEntry *)searchPtr->next;
    if (cPtr == NULL) {
	Tcl_DictObjDone(searchPtr);
	*donePtr = 1;
	return;
    }

    searchPtr->next = cPtr->nextPtr;
    *donePtr = 0;
    if (keyPtrPtr != NULL) {
	*keyPtrPtr = Tcl_GetHashKey(
	*keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(
		&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
    }
    if (valuePtrPtr != NULL) {
	*valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjDone --
1325
1326
1327
1328
1329
1330
1331
1332

1333
1334
1335
1336
1337
1338
1339
1326
1327
1328
1329
1330
1331
1332

1333
1334
1335
1336
1337
1338
1339
1340







-
+







    }

    DictGetIntRep(dictPtr, dict);
    assert(dict != NULL);
    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    InvalidateDictChain(dictPtr);

    return TCL_OK;
1420
1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1435







-
+







#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    dict = (Dict *)ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
#endif
1468
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482


1483
1484
1485
1486
1487
1488
1489
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492







-
+







+
+







{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = ckalloc(sizeof(Dict));
    dict = (Dict *)ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    return dictPtr;
#else /* !TCL_MEM_DEBUG */
    (void)file;
    (void)line;
    return Tcl_NewDictObj();
#endif
}

/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/

/*
1502
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514
1515

1516
1517
1518
1519
1520
1521
1522
1505
1506
1507
1508
1509
1510
1511

1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictCreateCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictObj;
    int i;
    (void)dummy;

    /*
     * Must have an even number of arguments; note that number of preceding
     * arguments (i.e. "dict create" is also even, which makes this much
     * easier.)
     */

1552
1553
1554
1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565

1566
1567
1568
1569
1570
1571
1572
1556
1557
1558
1559
1560
1561
1562

1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr = NULL;
    int result;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
	return TCL_ERROR;
    }

    /*
1645
1646
1647
1648
1649
1650
1651
1652

1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666
1650
1651
1652
1653
1654
1655
1656

1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672







-
+







+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetDefCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
    Tcl_Obj *const *keyPath;
    int numKeys;
    (void)dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...? key default");
	return TCL_ERROR;
    }

    /*
1710
1711
1712
1713
1714
1715
1716
1717

1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1716
1717
1718
1719
1720
1721
1722

1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictReplaceCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;
    (void)dummy;

    if ((objc < 2) || (objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
	return TCL_ERROR;
    }

    dictPtr = objv[1];
1758
1759
1760
1761
1762
1763
1764
1765

1766
1767
1768
1769
1770
1771

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

1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictRemoveCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = objv[1];
1806
1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1821

1822
1823
1824
1825
1826
1827
1828
1814
1815
1816
1817
1818
1819
1820

1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837







-
+








+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMergeCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
    int allocatedDict = 0;
    int i, done;
    Tcl_DictSearch search;
    (void)dummy;

    if (objc == 1) {
	/*
	 * No dictionary arguments; return default (empty value).
	 */

	return TCL_OK;
1893
1894
1895
1896
1897
1898
1899
1900

1901
1902
1903
1904
1905
1906

1907
1908
1909
1910
1911
1912
1913
1902
1903
1904
1905
1906
1907
1908

1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictKeysCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *listPtr;
    const char *pattern = NULL;
    (void)dummy;

    if (objc!=2 && objc!=3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
	return TCL_ERROR;
    }

    /*
1972
1973
1974
1975
1976
1977
1978
1979

1980
1981
1982
1983
1984
1985
1986
1987

1988
1989
1990
1991
1992
1993
1994
1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005







-
+








+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictValuesCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *valuePtr = NULL, *listPtr;
    Tcl_DictSearch search;
    int done;
    const char *pattern;
    (void)dummy;

    if (objc!=2 && objc!=3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
	return TCL_ERROR;
    }

    if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr,
2032
2033
2034
2035
2036
2037
2038
2039

2040
2041
2042
2043
2044

2045
2046
2047
2048
2049
2050
2051
2043
2044
2045
2046
2047
2048
2049

2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063







-
+





+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSizeCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result, size;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {
2070
2071
2072
2073
2074
2075
2076
2077

2078
2079
2080
2081
2082

2083
2084
2085
2086
2087
2088
2089
2082
2083
2084
2085
2086
2087
2088

2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102







-
+





+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictExistsCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS);
2112
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131
2132
2125
2126
2127
2128
2129
2130
2131

2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictInfoCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Dict *dict;
    char *statsStr;
    (void)dummy;

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

    dict = GetDictFromObj(interp, objv[1]);
2156
2157
2158
2159
2160
2161
2162
2163

2164
2165
2166
2167
2168
2169

2170
2171
2172
2173
2174
2175
2176
2170
2171
2172
2173
2174
2175
2176

2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictIncrCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int code = TCL_OK;
    Tcl_Obj *dictPtr, *valuePtr = NULL;
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
2276
2277
2278
2279
2280
2281
2282
2283

2284
2285
2286
2287
2288
2289

2290
2291
2292
2293
2294
2295
2296
2291
2292
2293
2294
2295
2296
2297

2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictLappendCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int i, allocatedDict = 0, allocatedValue = 0;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
2363
2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374
2375
2376

2377
2378
2379
2380
2381
2382
2383
2379
2380
2381
2382
2383
2384
2385

2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictAppendCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int allocatedDict = 0;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
2465
2466
2467
2468
2469
2470
2471
2472

2473
2474
2475
2476
2477
2478
2479
2480
2481

2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502

2503
2504
2505
2506
2507
2508
2509
2482
2483
2484
2485
2486
2487
2488

2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519

2520
2521
2522
2523
2524
2525
2526
2527







-
+









+




















-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictForNRCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj, *valueObj;
    Tcl_DictSearch *searchPtr;
    int varc, done;
    (void)dummy;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
	return TCL_ERROR;
    }
    searchPtr = TclStackAlloc(interp, sizeof(Tcl_DictSearch));
    searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch));
    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,
	    &done) != TCL_OK) {
	TclStackFree(interp, searchPtr);
	return TCL_ERROR;
    }
    if (done) {
	TclStackFree(interp, searchPtr);
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575




2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589




2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600







-
-
-
-
+
+
+
+







static int
DictForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_DictSearch *searchPtr = data[0];
    Tcl_Obj *keyVarObj = data[1];
    Tcl_Obj *valueVarObj = data[2];
    Tcl_Obj *scriptObj = data[3];
    Tcl_DictSearch *searchPtr = (Tcl_DictSearch *)data[0];
    Tcl_Obj *keyVarObj = (Tcl_Obj *)data[1];
    Tcl_Obj *valueVarObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673
2674
2675

2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696

2697
2698
2699
2700
2701
2702
2703
2678
2679
2680
2681
2682
2683
2684

2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722







-
+








+




















-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMapNRCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **varv, *keyObj, *valueObj;
    DictMapStorage *storagePtr;
    int varc, done;
    (void)dummy;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
	return TCL_ERROR;
    }
    storagePtr = TclStackAlloc(interp, sizeof(DictMapStorage));
    storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage));
    if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
	    &valueObj, &done) != TCL_OK) {
	TclStackFree(interp, storagePtr);
	return TCL_ERROR;
    }
    if (done) {
	/*
2769
2770
2771
2772
2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2788
2789
2790
2791
2792
2793
2794

2795
2796
2797
2798
2799
2800
2801
2802







-
+







static int
DictMapLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    DictMapStorage *storagePtr = data[0];
    DictMapStorage *storagePtr = (DictMapStorage *)data[0];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

2872
2873
2874
2875
2876
2877
2878
2879

2880
2881
2882
2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
2891
2892
2893
2894
2895
2896
2897

2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSetCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;
    (void)dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
2932
2933
2934
2935
2936
2937
2938
2939

2940
2941
2942
2943
2944
2945

2946
2947
2948
2949
2950
2951
2952
2952
2953
2954
2955
2956
2957
2958

2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictUnsetCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
2991
2992
2993
2994
2995
2996
2997
2998

2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014

3015
3016
3017
3018
3019
3020
3021
3012
3013
3014
3015
3016
3017
3018

3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043







-
+
















+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictFilterCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    static const char *const filters[] = {
	"key", "script", "value", NULL
    };
    enum FilterTypes {
	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
    };
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
    Tcl_DictSearch search;
    int index, varc, done, result, satisfied;
    const char *pattern;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
	     0, &index) != TCL_OK) {
3284
3285
3286
3287
3288
3289
3290

3291
3292
3293
3294
3295
3296
3297
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320







+







    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *objPtr;
    int i, dummy;
    (void)clientData;

    if (objc < 5 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"dictVarName key varName ?key varName ...? script");
	return TCL_ERROR;
    }

3337
3338
3339
3340
3341
3342
3343
3344
3345


3346
3347
3348
3349
3350
3351
3352
3360
3361
3362
3363
3364
3365
3366


3367
3368
3369
3370
3371
3372
3373
3374
3375







-
-
+
+







    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *dictPtr, *objPtr, **objv;
    Tcl_InterpState state;
    int i, objc;
    Tcl_Obj *varName = data[0];
    Tcl_Obj *argsObj = data[1];
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *argsObj = (Tcl_Obj *)data[1];

    /*
     * ErrorInfo handling.
     */

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict update\")");
3434
3435
3436
3437
3438
3439
3440
3441

3442
3443
3444
3445
3446
3447

3448
3449
3450
3451
3452
3453
3454
3457
3458
3459
3460
3461
3462
3463

3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478







-
+






+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictWithCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
	return TCL_ERROR;
    }

    /*
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497



3498
3499
3500
3501
3502
3503
3504
3512
3513
3514
3515
3516
3517
3518



3519
3520
3521
3522
3523
3524
3525
3526
3527
3528







-
-
-
+
+
+







    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    int pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = data[0];
    Tcl_Obj *keysPtr = data[1];
    Tcl_Obj *pathPtr = data[2];
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *keysPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
    }

    /*

Changes to generic/tclDisassemble.c.

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
19
20
21
22
23
24
25

26

27
28
29
30
31
32
33







-
+
-








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

static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Interp *interp,
static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Obj *objPtr);
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		GetLocationInformation(Proc *procPtr,
			    Tcl_Obj **fileObjPtr, int *linePtr);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144







-
+







 */

void
TclPrintByteCodeObj(
    Tcl_Interp *interp,		/* Used only for getting location info. */
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
    Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr);

    fprintf(stdout, "\n%s", TclGetString(bufPtr));
    Tcl_DecrRefCount(bufPtr);
}

/*
 *----------------------------------------------------------------------
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
246
247
248
249
250
251
252

253
254
255
256
257
258
259







-







 *	are made about the details of the contents of the result.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
DisassembleByteCodeObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
948
949
950
951
952
953
954
955

956
957
958
959
960
961
962
963
964

965
966
967
968
969
970
971
946
947
948
949
950
951
952

953

954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969







-
+
-








+







 *	format.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
DisassembleByteCodeAsDicts(
    Tcl_Interp *interp,		/* Used for looking up the CmdFrame for the
    Tcl_Interp *dummy,		/* Not used. */
				 * procedure, if one exists. */
    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
{
    ByteCode *codePtr;
    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
    Tcl_Obj *aux, *exn, *commands, *file;
    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
    int codeOffset, codeLength, sourceOffset, sourceLength;
    int i, val, line;
    (void)dummy;

    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

1573
1574
1575
1576
1577
1578
1579
1580

1581
1582
1583
1584
1585
1586
1587
1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583
1584
1585







-
+







	unknownMethod:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown method \"%s\"", TclGetString(objv[3])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(objv[3]), NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
	procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
1623
1624
1625
1626
1627
1628
1629
1630

1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640







-
+












	return TCL_ERROR;
    }
    if (clientData) {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeAsDicts(interp, codeObjPtr));
    } else {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeObj(interp, codeObjPtr));
		DisassembleByteCodeObj(codeObjPtr));
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclEncoding.c.

292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
292
293
294
295
296
297
298

299
300
301
302
303
304
305
306







-
+







	Tcl_StoreIntRep((objPtr), &encodingType, &ir);			\
    } while (0)

#define EncodingGetIntRep(objPtr, encoding)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep ((objPtr), &encodingType);		\
	(encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingFromObj --
639
640
641
642
643
644
645
646

647
648
649
650
651

652
653

654
655
656
657
658
659
660
639
640
641
642
643
644
645

646
647
648
649
650

651
652

653
654
655
656
657
658
659
660







-
+




-
+

-
+







    /*
     * Need the iso8859-1 encoding in order to process binary data, so force
     * it to always be embedded. Note that this encoding *must* be a proper
     * table encoding or some of the escape encodings crash! Hence the ugly
     * code to duplicate the structure of a table encoding here.
     */

    dataPtr = ckalloc(sizeof(TableEncodingData));
    dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';

    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
    dataPtr->toUnicode = ckalloc(size);
    dataPtr->toUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    dataPtr->fromUnicode = ckalloc(size);
    dataPtr->fromUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);

    dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
    dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
    for (i=1 ; i<256 ; i++) {
	dataPtr->toUnicode[i] = emptyPage;
	dataPtr->fromUnicode[i] = emptyPage;
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
712
713
714
715
716
717
718

719
720
721
722
723
724
725
726







-
+







	/*
	 * Call FreeEncoding instead of doing it directly to handle refcounts
	 * like escape encodings use. [Bug 524674] Make sure to call
	 * Tcl_FirstHashEntry repeatedly so that all encodings are eventually
	 * cleaned up.
	 */

	FreeEncoding(Tcl_GetHashValue(hPtr));
	FreeEncoding((Tcl_Encoding)Tcl_GetHashValue(hPtr));
	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    }

    Tcl_DeleteHashTable(&encodingTable);
    Tcl_MutexUnlock(&encodingMutex);
}

823
824
825
826
827
828
829
830

831
832
833
834
835
836
837
823
824
825
826
827
828
829

830
831
832
833
834
835
836
837







-
+







	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return systemEncoding;
    }

    hPtr = Tcl_FindHashEntry(&encodingTable, name);
    if (hPtr != NULL) {
	encodingPtr = Tcl_GetHashValue(hPtr);
	encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return (Tcl_Encoding) encodingPtr;
    }
    Tcl_MutexUnlock(&encodingMutex);

    return LoadEncodingFile(interp, name);
968
969
970
971
972
973
974
975

976
977
978
979
980
981
982
968
969
970
971
972
973
974

975
976
977
978
979
980
981
982







-
+







    /*
     * Copy encoding names from loaded encoding table to table.
     */

    Tcl_MutexLock(&encodingMutex);
    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Encoding *encodingPtr = Tcl_GetHashValue(hPtr);
	Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);

	Tcl_CreateHashEntry(&table,
		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
    }
    Tcl_MutexUnlock(&encodingMutex);

    FillEncodingFileMap();
1085
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095
1096
1097
1098
1099
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
1099







-
+







 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Encoding *encodingPtr = ckalloc(sizeof(Encoding));
    Encoding *encodingPtr = (Encoding *)ckalloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {
1113
1114
1115
1116
1117
1118
1119
1120

1121
1122
1123
1124

1125
1126
1127
1128
1129
1130
1131
1113
1114
1115
1116
1117
1118
1119

1120
1121
1122
1123

1124
1125
1126
1127
1128
1129
1130
1131







-
+



-
+







    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
    if (isNew == 0) {
	/*
	 * Remove old encoding from hash table, but don't delete it until last
	 * reference goes away.
	 */

	Encoding *replaceMe = Tcl_GetHashValue(hPtr);
	Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = ckalloc(strlen(typePtr->encodingName) + 1);
    name = (char *)ckalloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }
    return (Tcl_Encoding) encodingPtr;
1222
1223
1224
1225
1226
1227
1228
1229

1230
1231
1232
1233
1234
1235
1236
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1236







-
+







 *	The converted bytes are stored in the output buffer.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_ExternalToUtf(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Interp *dummy,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
1256
1257
1258
1259
1260
1261
1262

1263
1264
1265
1266
1267
1268
1269
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270







+







{
    const Encoding *encodingPtr;
    int result, srcRead, dstWrote, dstChars = 0;
    int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
    int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
    int maxChars = INT_MAX;
    Tcl_EncodingState state;
    (void)dummy;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
1413
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423
1424
1425
1426
1427
1428







-
+







 *	The converted bytes are stored in the output buffer.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_UtfToExternal(
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Interp *dummy,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
1444
1445
1446
1447
1448
1449
1450

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







+







    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const Encoding *encodingPtr;
    int result, srcRead, dstWrote, dstChars;
    Tcl_EncodingState state;
    (void)dummy;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
1784
1785
1786
1787
1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803

1804
1805
1806
1807
1808
1809
1810
1786
1787
1788
1789
1790
1791
1792

1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804

1805
1806
1807
1808
1809
1810
1811
1812







-
+











-
+







    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = ckalloc(sizeof(TableEncodingData));
    dataPtr = (TableEncodingData *)ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));

    dataPtr->fallback = fallback;

    /*
     * Read the table that maps characters to Unicode. Performs a single
     * malloc to get the memory for the array and all the pages needed by the
     * array.
     */

    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->toUnicode = ckalloc(size);
    dataPtr->toUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
1857
1858
1859
1860
1861
1862
1863
1864

1865
1866
1867
1868
1869
1870
1871
1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869
1870
1871
1872
1873







-
+







    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->fromUnicode = ckalloc(size);
    dataPtr->fromUnicode = (unsigned short **)ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);

    for (hi = 0; hi < 256; hi++) {
	if (dataPtr->toUnicode[hi] == NULL) {
	    dataPtr->toUnicode[hi] = emptyPage;
	    continue;
1889
1890
1891
1892
1893
1894
1895
1896
1897


1898
1899
1900
1901
1902
1903
1904
1891
1892
1893
1894
1895
1896
1897


1898
1899
1900
1901
1902
1903
1904
1905
1906







-
-
+
+







	 * If multibyte encodings don't have a backslash character, define
	 * one. Otherwise, on Windows, native file names don't work because
	 * the backslash in the file name maps to the unknown character
	 * (question mark) when converting from UTF-8 to external encoding.
	 */

	if (dataPtr->fromUnicode[0] != NULL) {
	    if (dataPtr->fromUnicode[0]['\\'] == '\0') {
		dataPtr->fromUnicode[0]['\\'] = '\\';
	    if (dataPtr->fromUnicode[0][(int)'\\'] == '\0') {
		dataPtr->fromUnicode[0][(int)'\\'] = '\\';
	    }
	}
    }
    if (symbol) {
	/*
	 * Make a special symbol encoding that maps each symbol character from
	 * its Unicode code point down into page 0, and also ensure that each
2095
2096
2097
2098
2099
2100
2101
2102

2103
2104
2105
2106
2107
2108
2109
2097
2098
2099
2100
2101
2102
2103

2104
2105
2106
2107
2108
2109
2110
2111







-
+







	}
	ckfree(argv);
	Tcl_DStringFree(&lineString);
    }

    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = ckalloc(size);
    dataPtr = (EscapeEncodingData *)ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
2174
2175
2176
2177
2178
2179
2180


2181
2182
2183
2184
2185
2186
2187
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191







+
+







				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    int result;
    (void)clientData;
    (void)statePtr;

    result = TCL_OK;
    dstLen -= TCL_UTF_MAX - 1;
    if (dstLen < 0) {
	dstLen = 0;
    }
    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
2345
2346
2347
2348
2349
2350
2351

2352
2353
2354
2355
2356
2357
2358
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363







+







				 * representation to real null-bytes or vice
				 * versa. Also combine or separate surrogate pairs */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars, charLimit = INT_MAX;
    Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
    (void)clientData;

    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }
    result = TCL_OK;

    srcStart = src;
2476
2477
2478
2479
2480
2481
2482

2483
2484
2485
2486
2487
2488
2489
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495







+







				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    unsigned short ch;
    (void)statePtr;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

    /* check alignment with utf-16 (2 == sizeof(UTF-16)) */
2697
2698
2699
2700
2701
2702
2703

2704
2705
2706
2707
2708
2709
2710
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717







+







{
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
#if TCL_UTF_MAX <= 3
    int len;
#endif
    Tcl_UniChar ch = 0;
    (void)statePtr;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }
2806
2807
2808
2809
2810
2811
2812
2813


2814
2815
2816
2817
2818
2819
2820
2813
2814
2815
2816
2817
2818
2819

2820
2821
2822
2823
2824
2825
2826
2827
2828







-
+
+







{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = clientData;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    (void)statePtr;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

2917
2918
2919
2920
2921
2922
2923
2924

2925

2926
2927
2928
2929
2930
2931
2932
2925
2926
2927
2928
2929
2930
2931

2932
2933
2934
2935
2936
2937
2938
2939
2940
2941







-
+

+







				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd, *prefixBytes;
    Tcl_UniChar ch = 0;
    int result, len, word, numChars;
    TableEncodingData *dataPtr = clientData;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    const unsigned short *const *fromUnicode;
    (void)statePtr;

    result = TCL_OK;

    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;

    srcStart = src;
3041
3042
3043
3044
3045
3046
3047


3048
3049
3050
3051
3052
3053
3054
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065







+
+







    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    (void)clientData;
    (void)statePtr;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

3124
3125
3126
3127
3128
3129
3130
3131

3132
3133
3134


3135
3136
3137
3138
3139
3140
3141
3135
3136
3137
3138
3139
3140
3141

3142
3143


3144
3145
3146
3147
3148
3149
3150
3151
3152







-
+

-
-
+
+







				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars;
    int result = TCL_OK, numChars;
    Tcl_UniChar ch = 0;

    result = TCL_OK;
    (void)clientData;
    (void)statePtr;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }
3212
3213
3214
3215
3216
3217
3218
3219

3220
3221
3222
3223
3224
3225
3226
3223
3224
3225
3226
3227
3228
3229

3230
3231
3232
3233
3234
3235
3236
3237







-
+







 */

static void
TableFreeProc(
    ClientData clientData)	/* TableEncodingData that specifies
				 * encoding. */
{
    TableEncodingData *dataPtr = clientData;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    ckfree(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
3270
3271
3272
3273
3274
3275
3276
3277

3278
3279
3280
3281
3282
3283
3284
3281
3282
3283
3284
3285
3286
3287

3288
3289
3290
3291
3292
3293
3294
3295







-
+







    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = clientData;
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
    const unsigned short *const *tableToUnicode;
    const Encoding *encodingPtr;
    int state, result, numChars, charLimit = INT_MAX;
    const char *dstStart, *dstEnd;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
3406
3407
3408
3409
3410
3411
3412
3413

3414
3415
3416
3417
3418
3419
3420
3417
3418
3419
3420
3421
3422
3423

3424
3425
3426
3427
3428
3429
3430
3431







-
+







	    break;
	}

	if (encodingPtr == NULL) {
	    TableEncodingData *tableDataPtr;

	    encodingPtr = GetTableEncoding(dataPtr, state);
	    tableDataPtr = encodingPtr->clientData;
	    tableDataPtr = (TableEncodingData *)encodingPtr->clientData;
	    tablePrefixBytes = tableDataPtr->prefixBytes;
	    tableToUnicode = (const unsigned short *const*)
		    tableDataPtr->toUnicode;
	}

	if (tablePrefixBytes[byte]) {
	    src++;
3484
3485
3486
3487
3488
3489
3490
3491

3492
3493
3494
3495
3496
3497
3498
3495
3496
3497
3498
3499
3500
3501

3502
3503
3504
3505
3506
3507
3508
3509







-
+







    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = clientData;
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const Encoding *encodingPtr;
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int state, result, numChars;
    const TableEncodingData *tableDataPtr;
    const char *tablePrefixBytes;
    const unsigned short *const *tableFromUnicode;
3525
3526
3527
3528
3529
3530
3531
3532

3533
3534
3535
3536
3537
3538
3539
3536
3537
3538
3539
3540
3541
3542

3543
3544
3545
3546
3547
3548
3549
3550







-
+







	memcpy(dst, dataPtr->init, dataPtr->initLen);
	dst += dataPtr->initLen;
    } else {
	state = PTR2INT(*statePtr);
    }

    encodingPtr = GetTableEncoding(dataPtr, state);
    tableDataPtr = encodingPtr->clientData;
    tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
    tablePrefixBytes = tableDataPtr->prefixBytes;
    tableFromUnicode = (const unsigned short *const *)
	    tableDataPtr->fromUnicode;

    for (numChars = 0; src < srcEnd; numChars++) {
	unsigned len;
	int word;
3553
3554
3555
3556
3557
3558
3559
3560

3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574

3575
3576
3577
3578
3579
3580
3581
3564
3565
3566
3567
3568
3569
3570

3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584

3585
3586
3587
3588
3589
3590
3591
3592







-
+













-
+







	if ((word == 0) && (ch != 0)) {
	    int oldState;
	    const EscapeSubTable *subTablePtr;

	    oldState = state;
	    for (state = 0; state < dataPtr->numSubTables; state++) {
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = encodingPtr->clientData;
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
		if (word != 0) {
		    break;
		}
	    }

	    if (word == 0) {
		state = oldState;
		if (flags & TCL_ENCODING_STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    break;
		}
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = encodingPtr->clientData;
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fallback;
	    }

	    tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
	    tableFromUnicode = (const unsigned short *const *)
		    tableDataPtr->fromUnicode;

3673
3674
3675
3676
3677
3678
3679
3680

3681
3682
3683
3684
3685
3686
3687
3684
3685
3686
3687
3688
3689
3690

3691
3692
3693
3694
3695
3696
3697
3698







-
+







 */

static void
EscapeFreeProc(
    ClientData clientData)	/* EscapeEncodingData that specifies
				 * encoding. */
{
    EscapeEncodingData *dataPtr = clientData;
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    EscapeSubTable *subTablePtr;
    int i;

    if (dataPtr == NULL) {
	return;
    }

3838
3839
3840
3841
3842
3843
3844
3845

3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867







-
+











    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetString(searchPathObj);

    *lengthPtr = searchPathObj->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclEnsemble.c.

92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106







-
+







	Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir);		\
    } while (0)

#define ECRGetIntRep(objPtr, ecRepPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &ensembleCmdType);		\
	(ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

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
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







-
+












+







 *	implementation prefix is configured.
 *
 *----------------------------------------------------------------------
 */

int
TclNamespaceEnsembleCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Namespace *namespacePtr;
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
	    *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    const char *simpleName;
    int index, done;
    (void)dummy;

    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
671
672
673
674
675
676
677
678

679
680
681
682
683
684
685
672
673
674
675
676
677
678

679
680
681
682
683
684
685
686







-
+







				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = ckalloc(sizeof(EnsembleConfig));
    ensemblePtr = (EnsembleConfig *)ckalloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	ckfree(ensemblePtr);
	return NULL;
    }
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808
795
796
797
798
799
800
801

802
803
804
805
806
807
808
809







-
+







	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->subcmdList;
    ensemblePtr->subcmdList = subcmdList;
    if (subcmdList != NULL) {
	Tcl_IncrRefCount(subcmdList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
870
871
872
873
874
875
876
877

878
879
880
881
882
883
884
871
872
873
874
875
876
877

878
879
880
881
882
883
884
885







-
+







	    return TCL_ERROR;
	}
	if (length < 1) {
	    paramList = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->parameterList;
    ensemblePtr->parameterList = paramList;
    if (paramList != NULL) {
	Tcl_IncrRefCount(paramList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
970
971
972
973
974
975
976
977

978
979
980
981
982
983
984
971
972
973
974
975
976
977

978
979
980
981
982
983
984
985







-
+







	}

	if (size < 1) {
	    mapDict = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldDict = ensemblePtr->subcommandDict;
    ensemblePtr->subcommandDict = mapDict;
    if (mapDict != NULL) {
	Tcl_IncrRefCount(mapDict);
    }
    if (oldDict != NULL) {
	TclDecrRefCount(oldDict);
1045
1046
1047
1048
1049
1050
1051
1052

1053
1054
1055
1056
1057
1058
1059
1046
1047
1048
1049
1050
1051
1052

1053
1054
1055
1056
1057
1058
1059
1060







-
+







	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->unknownHandler;
    ensemblePtr->unknownHandler = unknownList;
    if (unknownList != NULL) {
	Tcl_IncrRefCount(unknownList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
1101
1102
1103
1104
1105
1106
1107
1108

1109
1110
1111
1112
1113
1114
1115
1102
1103
1104
1105
1106
1107
1108

1109
1110
1111
1112
1113
1114
1115
1116







-
+







    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;

    /*
     * This API refuses to set the ENSEMBLE_DEAD flag...
     */

    ensemblePtr->flags &= ENSEMBLE_DEAD;
1179
1180
1181
1182
1183
1184
1185
1186

1187
1188
1189
1190
1191
1192
1193
1180
1181
1182
1183
1184
1185
1186

1187
1188
1189
1190
1191
1192
1193
1194







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1221
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1236







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *paramListPtr = ensemblePtr->parameterList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1263
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1278







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1304
1305
1306
1307
1308
1309
1310
1311

1312
1313
1314
1315
1316
1317
1318
1305
1306
1307
1308
1309
1310
1311

1312
1313
1314
1315
1316
1317
1318
1319







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1345
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357
1358
1359
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357
1358
1359
1360







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1386
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1387
1388
1389
1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1401







-
+







	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1686
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697
1698
1699
1700
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697
1698
1699
1700
1701







-
+







static int
NsEnsembleImplementationCmdNR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    EnsembleConfig *ensemblePtr = clientData;
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
				/* The ensemble itself. */
    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
				 * the command that implements the
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
1759
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1774







-
+







	 */
	EnsembleCmdRep *ensembleCmd;

	ECRGetIntRep(subObj, ensembleCmd);
	if (ensembleCmd) {
	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == (Command *)ensemblePtr->token) {
		prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
		prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr);
		Tcl_IncrRefCount(prefixObj);
		if (ensembleCmd->fix) {
		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
		}
		goto runResultingSubcommand;
	    }
	}
1862
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1877







-
+







	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
	TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
    }

    prefixObj = Tcl_GetHashValue(hPtr);
    prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    Tcl_IncrRefCount(prefixObj);
  runResultingSubcommand:

    /*
     * Do the real work of execution of the subcommand by building an array of
     * objects (note that this is potentially not the same length as the
     * number of arguments to this ensemble command), populating it and then
1983
1984
1985
1986
1987
1988
1989
1990

1991
1992
1993

1994
1995
1996
1997
1998
1999
2000
1984
1985
1986
1987
1988
1989
1990

1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002







-
+



+







    }
    Tcl_SetObjResult(interp, errorObj);
    return TCL_ERROR;
}

int
TclClearRootEnsemble(
    ClientData data[],
    ClientData dummy[],
    Tcl_Interp *interp,
    int result)
{
	(void)dummy;
    TclResetRewriteEnsemble(interp, 1);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
2090
2091
2092
2093
2094
2095
2096
2097

2098
2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
2092
2093
2094
2095
2096
2097
2098

2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111







-
+




+







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

static int
FreeER(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    Tcl_Obj **tmp = (Tcl_Obj **) data[0];
    Tcl_Obj **store = (Tcl_Obj **) data[1];
    (void)dummy;

    ckfree(store);
    ckfree(tmp);
    return result;
}

void
2172
2173
2174
2175
2176
2177
2178
2179

2180
2181

2182
2183
2184
2185
2186
2187
2188
2175
2176
2177
2178
2179
2180
2181

2182
2183

2184
2185
2186
2187
2188
2189
2190
2191







-
+

-
+







	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    }  else {
	Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
	Tcl_Obj **tmp = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *));

	store = ckalloc(size * sizeof(Tcl_Obj *));
	store = (Tcl_Obj **)ckalloc(size * sizeof(Tcl_Obj *));
	memcpy(store, iPtr->ensembleRewrite.sourceObjs,
		size * sizeof(Tcl_Obj *));

	/*
	 * Awful casting abuse here! Note that the NULL in the first element
	 * indicates that the initial objects are a raw array in the second
	 * element and the rewritten ones are a raw array in the third.
2414
2415
2416
2417
2418
2419
2420
2421

2422
2423
2424
2425
2426
2427
2428
2417
2418
2419
2420
2421
2422
2423

2424
2425
2426
2427
2428
2429
2430
2431







-
+







	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
	ensembleCmd = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));
	ECRSetIntRep(objPtr, ensembleCmd);
    }

    /*
     * Populate the internal rep.
     */

2463
2464
2465
2466
2467
2468
2469
2470

2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
2466
2467
2468
2469
2470
2471
2472

2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485

2486
2487
2488
2489
2490
2491
2492
2493







-
+












-
+







    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;

    if (hash->numEntries != 0) {
        Tcl_HashSearch search;
        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

        while (hPtr != NULL) {
            Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
            Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
{
    EnsembleConfig *ensemblePtr = clientData;
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
    Namespace *nsPtr = ensemblePtr->nsPtr;

    /*
     * Unlink from the ensemble chain if it has not been marked as having been
     * done already.
     */

2687
2688
2689
2690
2691
2692
2693
2694

2695
2696
2697
2698
2699
2700
2701
2690
2691
2692
2693
2694
2695
2696

2697
2698
2699
2700
2701
2702
2703
2704







-
+







	 * place them in the hash too, which should make for even faster
	 * matching.
	 */

	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
	    char *nsCmdName =		/* Name of command in namespace. */
		    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);
		    (char *)Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);

	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
		if (Tcl_StringMatch(nsCmdName,
			ensemblePtr->nsPtr->exportArrayPtr[i])) {
		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);

		    /*
2736
2737
2738
2739
2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2753







-
+







     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr =
	    ckalloc(sizeof(char *) * hash->numEntries);
	    (char **)ckalloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772

2773
2774
2775
2776
2777
2778
2779
2763
2764
2765
2766
2767
2768
2769

2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2782







-
+




-
+







     * awful runtime behaviour.
     */

    i = 0;
    j = hash->numEntries;
    hPtr = Tcl_FirstHashEntry(hash, &search);
    while (hPtr != NULL) {
	ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
	ensemblePtr->subcommandArrayPtr[i++] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	ensemblePtr->subcommandArrayPtr[--j] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}
2857
2858
2859
2860
2861
2862
2863
2864

2865
2866
2867
2868
2869
2870
2871
2860
2861
2862
2863
2864
2865
2866

2867
2868
2869
2870
2871
2872
2873
2874







-
+








static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd;
    EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)ckalloc(sizeof(EnsembleCmdRep));

    ECRGetIntRep(objPtr, ensembleCmd);
    ECRSetIntRep(copyPtr, ensembleCopy);

    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;

Changes to generic/tclEnv.c.

119
120
121
122
123
124
125
126

127
128
129
130
131
132
133
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133







-
+







	Tcl_MutexLock(&envMutex);
	for (i = 0; environ[i] != NULL; i++) {
	    Tcl_Obj *obj1, *obj2;
	    const char *p1;
	    char *p2;

	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
	    p2 = strchr(p1, '=');
	    p2 = (char *)strchr(p1, '=');
	    if (p2 == NULL) {
		/*
		 * This condition seem to happen occasionally under some
		 * versions of Solaris, or when encoding accidents swallow the
		 * '='; ignore the entry.
		 */

168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182







-
+







    /*
     * Delete those elements that existed in the array but which had no
     * counterparts in the environment array.
     */

    for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
	    hPtr=Tcl_NextHashEntry(&search)) {
	Tcl_Obj *elemName = Tcl_GetHashValue(hPtr);
	Tcl_Obj *elemName = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
    }
    Tcl_DeleteHashTable(&namesHash);
    Tcl_DecrRefCount(varNamePtr);

    /*
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249







-
+







	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
	    char **newEnviron = ckalloc((length + 5) * sizeof(char *));
	    char **newEnviron = (char **)ckalloc((length + 5) * sizeof(char *));

	    memcpy(newEnviron, environ, length * sizeof(char *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		ckfree(env.ourEnviron);
	    }
	    environ = env.ourEnviron = newEnviron;
	    env.ourEnvironSize = length + 5;
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
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







-
+









-
+







    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */

    valueLength = strlen(value);
    p = ckalloc(nameLength + valueLength + 2);
    p = (char *)ckalloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    p = (char *)ckrealloc(p, Tcl_DStringLength(&envString) + 1);
    memcpy(p, p2, Tcl_DStringLength(&envString) + 1);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */
375
376
377
378
379
380
381
382

383
384
385
386
387
388
389
375
376
377
378
379
380
381

382
383
384
385
386
387
388
389







-
+








    /*
     * First convert the native string to UTF. Then separate the string into
     * name and value parts, and call TclSetEnv to do all of the real work.
     */

    name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
    value = strchr(name, '=');
    value = (char *)strchr(name, '=');

    if ((value != NULL) && (value != name)) {
	value[0] = '\0';
	TclSetEnv(name, value+1);
    }

    Tcl_DStringFree(&nameString);
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
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







-
+




-
+





-
+







#ifdef USE_PUTENV_FOR_UNSET
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = ckalloc(length + 2);
    string = (char *)ckalloc(length + 2);
    memcpy(string, name, length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = ckalloc(length + 1);
    string = (char *)ckalloc(length + 1);
    memcpy(string, name, length);
    string[length] = '\0';
#endif /* _WIN32 */

    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = ckrealloc(string, Tcl_DStringLength(&envString) + 1);
    string = (char *)ckrealloc(string, Tcl_DStringLength(&envString) + 1);
    memcpy(string, Tcl_DStringValue(&envString),
	    Tcl_DStringLength(&envString)+1);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
575
576
577
578
579
580
581
582

583
584
585
586
587
588
589

590
591
592
593
594
595
596
575
576
577
578
579
580
581

582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597







-
+







+







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

	/* ARGSUSED */
static char *
EnvTraceProc(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter whose "env" variable is being
				 * modified. */
    const char *name1,		/* Better be "env". */
    const char *name2,		/* Name of variable being modified, or NULL if
				 * whole array is being deleted (UTF-8). */
    int flags)			/* Indicates what's happening. */
{
	(void)dummy;
    /*
     * For array traces, let TclSetupEnv do all the work.
     */

    if (flags & TCL_TRACE_ARRAY) {
	TclSetupEnv(interp);
	return NULL;
697
698
699
700
701
702
703
704

705
706
707
708
709
710
711
698
699
700
701
702
703
704

705
706
707
708
709
710
711
712







-
+







    } else {
	/*
	 * We need to grow the cache in order to hold the new string.
	 */

	const int growth = 5;

	env.cache = ckrealloc(env.cache,
	env.cache = (char **)ckrealloc(env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(size_t) (growth-1) * sizeof(char *));
	env.cacheSize += growth;
    }
}

Changes to generic/tclEvent.c.

51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65







-
+







/*
 * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
 * there is a structure of the following type:
 */

typedef struct ExitHandler {
    Tcl_ExitProc *proc;		/* Function to call when process exits. */
    ClientData clientData;	/* One word of information to pass to proc. */
    void *clientData;	/* One word of information to pass to proc. */
    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
				 * application, or NULL for end of list. */
} ExitHandler;

/*
 * There is both per-process and per-thread exit handlers. The first list is
 * controlled by a mutex. The other is in thread local storage.
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
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







-
+

-
+






-
+

-
-
+
+







				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    ClientData clientData;	/* The one argument to Main() */
    void *clientData;	/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
static Tcl_ThreadCreateType NewThreadProc(void *clientData);
#endif /* TCL_THREADS */

/*
 * Prototypes for functions referenced only in this file:
 */

static void		BgErrorDeleteProc(ClientData clientData,
static void		BgErrorDeleteProc(void *clientData,
			    Tcl_Interp *interp);
static void		HandleBgErrors(ClientData clientData);
static char *		VwaitVarProc(ClientData clientData,
static void		HandleBgErrors(void *clientData);
static char *		VwaitVarProc(void *clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		InvokeExitHandlers(void);
static void		FinalizeThread(int quick);

/*
 *----------------------------------------------------------------------
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181







-
+







-
+







    BgError *errPtr;
    ErrAssocData *assocPtr;

    if (code == TCL_OK) {
	return;
    }

    errPtr = ckalloc(sizeof(BgError));
    errPtr = (BgError*)ckalloc(sizeof(BgError));
    errPtr->errorMsg = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(errPtr->errorMsg);
    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
    Tcl_IncrRefCount(errPtr->returnOpts);
    errPtr->nextPtr = NULL;

    (void) TclGetBgErrorHandler(interp);
    assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
    assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
    if (assocPtr->firstBgPtr == NULL) {
	assocPtr->firstBgPtr = errPtr;
	Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
    } else {
	assocPtr->lastBgPtr->nextPtr = errPtr;
    }
    assocPtr->lastBgPtr = errPtr;
197
198
199
200
201
202
203
204

205
206

207
208
209
210
211
212
213
197
198
199
200
201
202
203

204
205

206
207
208
209
210
211
212
213







-
+

-
+







 *	Depends on what actions the handler command takes for the errors.
 *
 *----------------------------------------------------------------------
 */

static void
HandleBgErrors(
    ClientData clientData)	/* Pointer to ErrAssocData structure. */
    void *clientData)	/* Pointer to ErrAssocData structure. */
{
    ErrAssocData *assocPtr = clientData;
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    Tcl_Interp *interp = assocPtr->interp;
    BgError *errPtr;

    /*
     * Not bothering to save/restore the interp state. Assume that any code
     * that has interp state it needs to keep will make its own
     * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent()
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240







-
+







	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);

	errPtr = assocPtr->firstBgPtr;

	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
	tempObjv[prefixObjc+1] = errPtr->returnOpts;
	Tcl_AllowExceptions(interp);
	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);

	/*
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322

323
324
325
326
327
328
329
307
308
309
310
311
312
313

314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330







-
+








+







 *	Depends on what actions the "bgerror" command takes for the errors.
 *
 *----------------------------------------------------------------------
 */

int
TclDefaultBgErrorHandlerObjCmd(
    ClientData dummy,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *keyPtr, *valuePtr;
    Tcl_Obj *tempObjv[2];
    int result, code, level;
    Tcl_InterpState saved;
    (void)dummy;

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

    /*
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539







-
+









-
+







 */

void
TclSetBgErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *cmdPrefix)
{
    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
    ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);

    if (cmdPrefix == NULL) {
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = ckalloc(sizeof(ErrAssocData));
	assocPtr = (ErrAssocData*)ckalloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
    }
    if (assocPtr->cmdPrefix) {
559
560
561
562
563
564
565
566

567
568
569
570
571
572
573

574
575
576
577
578
579
580
560
561
562
563
564
565
566

567
568
569
570
571
572
573

574
575
576
577
578
579
580
581







-
+






-
+







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

Tcl_Obj *
TclGetBgErrorHandler(
    Tcl_Interp *interp)
{
    ErrAssocData *assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
    ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);

    if (assocPtr == NULL) {
	Tcl_Obj *bgerrorObj;

	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
	TclSetBgErrorHandler(interp, bgerrorObj);
	assocPtr = Tcl_GetAssocData(interp, "tclBgError", NULL);
	assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
    }
    return assocPtr->cmdPrefix;
}

/*
 *----------------------------------------------------------------------
 *
592
593
594
595
596
597
598
599
600


601
602

603

604
605
606
607
608
609
610
593
594
595
596
597
598
599


600
601
602

603
604
605
606
607
608
609
610
611
612







-
-
+
+

-
+

+







 *	reports, they are canceled.
 *
 *----------------------------------------------------------------------
 */

static void
BgErrorDeleteProc(
    ClientData clientData,	/* Pointer to ErrAssocData structure. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
    void *clientData,	/* Pointer to ErrAssocData structure. */
    Tcl_Interp *dummy)		/* Interpreter being deleted. */
{
    ErrAssocData *assocPtr = clientData;
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    BgError *errPtr;
    (void)dummy;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	ckfree(errPtr);
631
632
633
634
635
636
637
638

639
640

641
642
643
644
645
646
647
633
634
635
636
637
638
639

640
641

642
643
644
645
646
647
648
649







-
+

-
+







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

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
    ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
664
665
666
667
668
669
670
671

672
673

674
675
676
677
678
679
680
666
667
668
669
670
671
672

673
674

675
676
677
678
679
680
681
682







-
+

-
+







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

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = ckalloc(sizeof(ExitHandler));
    ExitHandler *exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));

    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
697
698
699
700
701
702
703
704

705
706
707
708
709
710
711
699
700
701
702
703
704
705

706
707
708
709
710
711
712
713







-
+







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

void
Tcl_DeleteExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
740
741
742
743
744
745
746
747

748
749
750
751
752
753
754
742
743
744
745
746
747
748

749
750
751
752
753
754
755
756







-
+







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

void
TclDeleteLateExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
783
784
785
786
787
788
789
790

791
792
793
794
795

796
797
798
799
800
801
802
785
786
787
788
789
790
791

792
793
794
795
796

797
798
799
800
801
802
803
804







-
+




-
+







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

void
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = ckalloc(sizeof(ExitHandler));
    exitPtr = (ExitHandler*)ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*
816
817
818
819
820
821
822
823

824
825
826
827
828
829
830
818
819
820
821
822
823
824

825
826
827
828
829
830
831
832







-
+







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

void
Tcl_DeleteThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
    void *clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
1292
1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1294
1295
1296
1297
1298
1299
1300

1301
1302
1303
1304
1305
1306
1307
1308







-
+








    /*
     * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
     * we don't want to initialize the data block if it hasn't been
     * initialized already.
     */

    tsdPtr = TclThreadDataKeyGet(&dataKey);
    tsdPtr = (ThreadSpecificData*)TclThreadDataKeyGet(&dataKey);
    if (tsdPtr != NULL) {
	tsdPtr->inExit = 1;

	for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
		exitPtr = tsdPtr->firstExitPtr) {
	    /*
	     * Be careful to remove the handler from the list before invoking
1367
1368
1369
1370
1371
1372
1373
1374

1375
1376
1377
1378
1379
1380
1381
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
1383







-
+







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

int
TclInThreadExit(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
	return 0;
    }
    return tsdPtr->inExit;
}

1395
1396
1397
1398
1399
1400
1401
1402

1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1397
1398
1399
1400
1401
1402
1403

1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418







-
+






+







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

	/* ARGSUSED */
int
Tcl_VwaitObjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int done, foundEvent;
    const char *nameString;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    nameString = Tcl_GetString(objv[1]);
    if (Tcl_TraceVar2(interp, nameString, NULL,
1459
1460
1461
1462
1463
1464
1465
1466

1467
1468
1469
1470
1471
1472


1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
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







-
+





-
+
+


-
+







    Tcl_ResetResult(interp);
    return TCL_OK;
}

	/* ARGSUSED */
static char *
VwaitVarProc(
    ClientData clientData,	/* Pointer to integer to set to 1. */
    void *clientData,	/* Pointer to integer to set to 1. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    int *donePtr = clientData;
    int *donePtr = (int *)clientData;
    (void)flags;

    *donePtr = 1;
    Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
    Tcl_UntraceVar2(interp, name1, name2, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, clientData);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1508

1509
1510
1511
1512
1513
1514
1515
1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520







-
+








+







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

	/* ARGSUSED */
int
Tcl_UpdateObjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;
    int flags = 0;		/* Initialized to avoid compiler warning. */
    static const char *const updateOptions[] = {"idletasks", NULL};
    enum updateOptions {OPT_IDLETASKS};
    (void)dummy;

    if (objc == 1) {
	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
    } else if (objc == 2) {
	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
		"option", 0, &optionIndex) != TCL_OK) {
	    return TCL_ERROR;
1561
1562
1563
1564
1565
1566
1567
1568

1569
1570
1571


1572
1573
1574
1575
1576
1577
1578
1566
1567
1568
1569
1570
1571
1572

1573
1574


1575
1576
1577
1578
1579
1580
1581
1582
1583







-
+

-
-
+
+







 *	Initializes Tcl notifier for the current thread.
 *
 *----------------------------------------------------------------------
 */

static Tcl_ThreadCreateType
NewThreadProc(
    ClientData clientData)
    void *clientData)
{
    ThreadClientData *cdPtr = clientData;
    ClientData threadClientData;
    ThreadClientData *cdPtr = (ThreadClientData *)clientData;
    void *threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    ckfree(clientData);		/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);
1600
1601
1602
1603
1604
1605
1606
1607

1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1605
1606
1607
1608
1609
1610
1611

1612
1613
1614
1615
1616
1617

1618
1619
1620
1621
1622
1623
1624
1625







-
+





-
+







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

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    void *clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
    ThreadClientData *cdPtr = (ThreadClientData *)ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	ckfree(cdPtr);

Changes to generic/tclExecute.c.

198
199
200
201
202
203
204
205

206
207
208
209
210
211
212
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212







-
+







	objPtr->internalRep.twoPtrValue.ptr1 = auxObjList;	\
	auxObjList = objPtr;					\
    } while (0)

#define POP_TAUX_OBJ() \
    do {							\
	tmpPtr = auxObjList;					\
	auxObjList = tmpPtr->internalRep.twoPtrValue.ptr1;	\
	auxObjList = (Tcl_Obj *)tmpPtr->internalRep.twoPtrValue.ptr1;	\
	Tcl_DecrRefCount(tmpPtr);				\
    } while (0)

/*
 * These variable-access macros have to coincide with those in tclVar.c
 */

765
766
767
768
769
770
771
772

773
774
775
776

777
778
779
780
781
782
783
765
766
767
768
769
770
771

772
773
774
775

776
777
778
779
780
781
782
783







-
+



-
+







    assert(irPtr != NULL);

    /*
     * First kill the search, and then release the reference to the dictionary
     * that we were holding.
     */

    searchPtr = irPtr->twoPtrValue.ptr1;
    searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
    Tcl_DictObjDone(searchPtr);
    ckfree(searchPtr);

    dictPtr = irPtr->twoPtrValue.ptr2;
    dictPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;
    TclDecrRefCount(dictPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InitByteCodeExecution --
842
843
844
845
846
847
848
849
850


851
852
853
854
855
856
857
842
843
844
845
846
847
848


849
850
851
852
853
854
855
856
857







-
-
+
+







ExecEnv *
TclCreateExecEnv(
    Tcl_Interp *interp,		/* Interpreter for which the execution
				 * environment is being created. */
    int size)			/* The initial stack size, in number of words
				 * [sizeof(Tcl_Obj*)] */
{
    ExecEnv *eePtr = ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = ckalloc(sizeof(ExecStack)
    ExecEnv *eePtr = (ExecEnv *)ckalloc(sizeof(ExecEnv));
    ExecStack *esPtr = (ExecStack *)ckalloc(sizeof(ExecStack)
	    + (size_t) (size-1) * sizeof(Tcl_Obj *));

    eePtr->execStackPtr = esPtr;
    TclNewIntObj(eePtr->constants[0], 0);
    Tcl_IncrRefCount(eePtr->constants[0]);
    TclNewIntObj(eePtr->constants[1], 1);
    Tcl_IncrRefCount(eePtr->constants[1]);
1112
1113
1114
1115
1116
1117
1118
1119

1120
1121
1122
1123
1124
1125
1126
1112
1113
1114
1115
1116
1117
1118

1119
1120
1121
1122
1123
1124
1125
1126







-
+







#else
    newElems = needed;
#endif

    newBytes = sizeof(ExecStack) + (newElems-1) * sizeof(Tcl_Obj *);

    oldPtr = esPtr;
    esPtr = ckalloc(newBytes);
    esPtr = (ExecStack *)ckalloc(newBytes);

    oldPtr->nextPtr = esPtr;
    esPtr->prevPtr = oldPtr;
    esPtr->nextPtr = NULL;
    esPtr->endPtr = &esPtr->stackWords[newElems-1];

  newStackReady:
1357
1358
1359
1360
1361
1362
1363
1364
1365



1366
1367
1368
1369
1370
1371
1372
1357
1358
1359
1360
1361
1362
1363


1364
1365
1366
1367
1368
1369
1370
1371
1372
1373







-
-
+
+
+








static int
CopyCallback(
    ClientData data[],
    Tcl_Interp *dummy,
    int result)
{
    Tcl_Obj **resultPtrPtr = data[0];
    Tcl_Obj *resultPtr = data[1];
    Tcl_Obj **resultPtrPtr = (Tcl_Obj **)data[0];
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];
    (void)dummy;
    (void)dummy;

    if (result == TCL_OK) {
	*resultPtrPtr = resultPtr;
	Tcl_IncrRefCount(resultPtr);
    } else {
	Tcl_DecrRefCount(resultPtr);
1416
1417
1418
1419
1420
1421
1422
1423
1424


1425
1426
1427
1428
1429
1430
1431
1417
1418
1419
1420
1421
1422
1423


1424
1425
1426
1427
1428
1429
1430
1431
1432







-
-
+
+








static int
ExprObjCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_InterpState state = data[0];
    Tcl_Obj *resultPtr = data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[0];
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[1];

    if (result == TCL_OK) {
	TclSetDuplicateObj(resultPtr, Tcl_GetObjResult(interp));
	(void) Tcl_RestoreInterpState(interp, state);
    } else {
	Tcl_DiscardInterpState(state);
    }
1705
1706
1707
1708
1709
1710
1711
1712

1713
1714

1715
1716
1717
1718
1719
1720
1721
1706
1707
1708
1709
1710
1711
1712

1713
1714

1715
1716
1717
1718
1719
1720
1721
1722







-
+

-
+







	    CmdFrame *ctxCopyPtr;
	    int redo;

	    if (!hePtr) {
		return codePtr;
	    }

	    eclPtr = Tcl_GetHashValue(hePtr);
	    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
	    redo = 0;
	    ctxCopyPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	    ctxCopyPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	    *ctxCopyPtr = *invoker;

	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctx.data.eval.path    is not used.
		 *		    ctx.data.tebc.codePtr used instead
		 */
2062
2063
2064
2065
2066
2067
2068
2069

2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081

2082
2083
2084
2085
2086
2087
2088
2063
2064
2065
2066
2067
2068
2069

2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081

2082
2083
2084
2085
2086
2087
2088
2089







-
+











-
+







#define TCONST(i)	(constants[(i)])

    /*
     * These macros are just meant to save some global variables that are not
     * used too frequently
     */

    TEBCdata *TD = data[0];
    TEBCdata *TD = (TEBCdata *)data[0];
#define auxObjList	(TD->auxObjList)
#define catchTop	(TD->catchTop)
#define codePtr		(TD->codePtr)
#define curEvalFlags	PTR2INT(data[3])  /* calling iPtr->evalFlags */

    /*
     * Globals: variables that store state, must remain valid at all times.
     */

    Tcl_Obj **tosPtr;		/* Cached pointer to top of evaluation
				 * stack. */
    const unsigned char *pc = data[1];
    const unsigned char *pc = (const unsigned char *)data[1];
                                /* The current program counter. */
    unsigned char inst;         /* The currently running instruction */

    /*
     * Transfer variables - needed only between opcodes, but not while
     * executing an instruction.
     */
4542
4543
4544
4545
4546
4547
4548
4549

4550
4551
4552
4553
4554
4555
4556
4543
4544
4545
4546
4547
4548
4549

4550
4551
4552
4553
4554
4555
4556
4557







-
+







		    "self may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = framePtr->clientData;
	contextPtr = (CallContext *)framePtr->clientData;

	/*
	 * Call out to get the name; it's expensive to compute but cached.
	 */

	objResultPtr = TclOOObjectName(interp, contextPtr->oPtr);
	TRACE_WITH_OBJ(("=> "), objResultPtr);
4570
4571
4572
4573
4574
4575
4576
4577

4578
4579
4580
4581
4582
4583
4584
4571
4572
4573
4574
4575
4576
4577

4578
4579
4580
4581
4582
4583
4584
4585







-
+







		    "nextto may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = framePtr->clientData;
	contextPtr = (CallContext *)framePtr->clientData;

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr);
	if (oPtr == NULL) {
	    TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr)));
	    goto gotError;
	} else {
	    Class *classPtr = oPtr->classPtr;
4669
4670
4671
4672
4673
4674
4675
4676

4677
4678
4679
4680
4681
4682
4683
4670
4671
4672
4673
4674
4675
4676

4677
4678
4679
4680
4681
4682
4683
4684







-
+







		    "next may only be called from inside a method",
		    -1));
	    DECACHE_STACK_INFO();
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    CACHE_STACK_INFO();
	    goto gotError;
	}
	contextPtr = framePtr->clientData;
	contextPtr = (CallContext *)framePtr->clientData;

	newDepth = contextPtr->index + 1;
	if (newDepth >= contextPtr->callPtr->numChain) {
	    /*
	     * We're at the end of the chain; generate an error message unless
	     * the interpreter is being torn down, in which case we might be
	     * getting here because of methods/destructors doing a [next] (or
6422
6423
6424
6425
6426
6427
6428
6429

6430
6431
6432
6433
6434
6435
6436
6423
6424
6425
6426
6427
6428
6429

6430
6431
6432
6433
6434
6435
6436
6437







-
+







    case INST_FOREACH_START4: /* DEPRECATED */
	/*
	 * Initialize the temporary local var that holds the count of the
	 * number of iterations of the loop body to -1.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	iterTmpIndex = infoPtr->loopCtTemp;
	iterVarPtr = LOCAL(iterTmpIndex);
	oldValuePtr = iterVarPtr->value.objPtr;

	if (oldValuePtr == NULL) {
	    TclNewIntObj(iterVarPtr->value.objPtr, -1);
	    Tcl_IncrRefCount(iterVarPtr->value.objPtr);
6456
6457
6458
6459
6460
6461
6462
6463

6464
6465
6466
6467
6468
6469
6470
6457
6458
6459
6460
6461
6462
6463

6464
6465
6466
6467
6468
6469
6470
6471







-
+







	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;

	/*
	 * Increment the temp holding the loop iteration number.
	 */

	iterVarPtr = LOCAL(infoPtr->loopCtTemp);
6586
6587
6588
6589
6590
6591
6592
6593

6594
6595
6596
6597
6598
6599
6600
6587
6588
6589
6590
6591
6592
6593

6594
6595
6596
6597
6598
6599
6600
6601







-
+







    case INST_FOREACH_START:
	/*
	 * Initialize the data for the looping construct, pushing the
	 * corresponding Tcl_Objs to the stack.
	 */

	opnd = TclGetUInt4AtPtr(pc+1);
	infoPtr = codePtr->auxDataArrayPtr[opnd].clientData;
	infoPtr = (ForeachInfo *)codePtr->auxDataArrayPtr[opnd].clientData;
	numLists = infoPtr->numLists;
	TRACE(("%u => ", opnd));

	/*
	 * Compute the number of iterations that will be run: iterMax
	 */

6654
6655
6656
6657
6658
6659
6660
6661

6662
6663
6664
6665
6666
6667
6668
6655
6656
6657
6658
6659
6660
6661

6662
6663
6664
6665
6666
6667
6668
6669







-
+







    case INST_FOREACH_STEP:
	/*
	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
	 * the next value list element to each loop var.
	 */

	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> "));

	tmpPtr = OBJ_AT_DEPTH(1);
	iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
	iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;

6738
6739
6740
6741
6742
6743
6744
6745

6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762

6763
6764
6765
6766
6767
6768
6769
6739
6740
6741
6742
6743
6744
6745

6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762

6763
6764
6765
6766
6767
6768
6769
6770







-
+
















-
+







	 */
	pc++;
#endif

    case INST_FOREACH_END:
	/* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */
	tmpPtr = OBJ_AT_TOS;
	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE(("=> loop terminated\n"));
	NEXT_INST_V(1, numLists+2, 0);

    case INST_LMAP_COLLECT:
	/*
	 * This instruction is only issued by lmap. The stack is:
	 *   - result
	 *   - infoPtr
	 *   - loop counters
	 *   - valLists
	 *   - collecting obj (unshared)
	 * The instruction lappends the result to the collecting obj.
	 */

	tmpPtr = OBJ_AT_DEPTH(1);
	infoPtr = tmpPtr->internalRep.twoPtrValue.ptr1;
	infoPtr = (ForeachInfo *)tmpPtr->internalRep.twoPtrValue.ptr1;
	numLists = infoPtr->numLists;
	TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists));

	objPtr = OBJ_AT_DEPTH(3 + numLists);
	Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS);
	NEXT_INST_F(1, 1, 0);
    }
7202
7203
7204
7205
7206
7207
7208
7209

7210
7211
7212
7213
7214
7215
7216
7203
7204
7205
7206
7207
7208
7209

7210
7211
7212
7213
7214
7215
7216
7217







-
+







	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
	NEXT_INST_F(5, 2, 1);

    case INST_DICT_FIRST:
	opnd = TclGetUInt4AtPtr(pc+1);
	TRACE(("%u => ", opnd));
	dictPtr = POP_OBJECT();
	searchPtr = ckalloc(sizeof(Tcl_DictSearch));
	searchPtr = (Tcl_DictSearch *)ckalloc(sizeof(Tcl_DictSearch));
	if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr,
		&valuePtr, &done) != TCL_OK) {

	    /*
	     * dictPtr is no longer on the stack, and we're not
	     * moving it into the intrep of an iterator.  We need
	     * to drop the refcount [Tcl Bug 9b352768e6].
7244
7245
7246
7247
7248
7249
7250
7251

7252
7253
7254
7255
7256
7257
7258
7245
7246
7247
7248
7249
7250
7251

7252
7253
7254
7255
7256
7257
7258
7259







-
+







	TRACE(("%u => ", opnd));
	statePtr = (*LOCAL(opnd)).value.objPtr;
	{
	    const Tcl_ObjIntRep *irPtr;

	    if (statePtr &&
		    (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) {
		searchPtr = irPtr->twoPtrValue.ptr1;
		searchPtr = (Tcl_DictSearch *)irPtr->twoPtrValue.ptr1;
		Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
	    } else {
		Tcl_Panic("mis-issued dictNext!");
	    }
	}
    pushDictIteratorResult:
	if (done) {
7276
7277
7278
7279
7280
7281
7282
7283

7284
7285
7286
7287
7288
7289
7290
7277
7278
7279
7280
7281
7282
7283

7284
7285
7286
7287
7288
7289
7290
7291







-
+







	JUMP_PEEPHOLE_F(done, 5, 0);

    case INST_DICT_UPDATE_START:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
7336
7337
7338
7339
7340
7341
7342
7343

7344
7345
7346
7347
7348
7349
7350
7337
7338
7339
7340
7341
7342
7343

7344
7345
7346
7347
7348
7349
7350
7351







-
+







	NEXT_INST_F(9, 0, 0);

    case INST_DICT_UPDATE_END:
	opnd = TclGetUInt4AtPtr(pc+1);
	opnd2 = TclGetUInt4AtPtr(pc+5);
	TRACE(("%u => ", opnd));
	varPtr = LOCAL(opnd);
	duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData;
	duiPtr = (DictUpdateInfo *)codePtr->auxDataArrayPtr[opnd2].clientData;
	while (TclIsVarLink(varPtr)) {
	    varPtr = varPtr->value.linkPtr;
	}
	if (TclIsVarDirectReadable(varPtr)) {
	    dictPtr = varPtr->value.objPtr;
	} else {
	    DECACHE_STACK_INFO();
7877
7878
7879
7880
7881
7882
7883
7884

7885
7886
7887
7888
7889
7890

7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910

7911
7912
7913
7914
7915
7916

7917
7918
7919
7920
7921
7922
7923
7878
7879
7880
7881
7882
7883
7884

7885
7886
7887
7888
7889
7890

7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910

7911
7912
7913
7914
7915
7916

7917
7918
7919
7920
7921
7922
7923
7924







-
+





-
+



















-
+





-
+







static int
FinalizeOONext(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = data[1];
    CallContext *contextPtr = (CallContext *)data[1];

    /*
     * Reset the variable lookup frame.
     */

    iPtr->varFramePtr = data[0];
    iPtr->varFramePtr = (CallFrame *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[2]);
    contextPtr->skip = PTR2INT(data[3]);
    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    return result;
}

static int
FinalizeOONextFilter(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = data[1];
    CallContext *contextPtr = (CallContext *)data[1];

    /*
     * Reset the variable lookup frame.
     */

    iPtr->varFramePtr = data[0];
    iPtr->varFramePtr = (CallFrame *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[2]);
9280
9281
9282
9283
9284
9285
9286
9287

9288
9289
9290
9291
9292
9293
9294
9281
9282
9283
9284
9285
9286
9287

9288
9289
9290
9291
9292
9293
9294
9295







-
+







		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);

	if (!hePtr) {
	    return;
	}

	srcOffset = cfPtr->cmd - codePtr->source;
	eclPtr = Tcl_GetHashValue(hePtr);
	eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);

	for (i=0; i < eclPtr->nuloc; i++) {
	    if (eclPtr->loc[i].srcOffset == srcOffset) {
		locPtr = eclPtr->loc+i;
		break;
	    }
	}

Changes to generic/tclFCmd.c.

43
44
45
46
47
48
49
50

51
52
53
54
55

56
57
58
59
60
61
62
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57
58
59
60
61
62
63







-
+





+







 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileRenameCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* Interp for error reporting or recursive
				 * calls in the case of a tricky rename. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    (void)dummy;
    return FileCopyRename(interp, objc, objv, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileCopyCmd
72
73
74
75
76
77
78
79

80
81
82
83
84

85
86
87
88
89
90
91
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87
88
89
90
91
92
93







-
+





+







 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileCopyCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* Used for error reporting or recursive calls
				 * in the case of a tricky copy. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    (void)dummy;
    return FileCopyRename(interp, objc, objv, 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * FileCopyRename --
210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236







-
+









+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileMakeDirsCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* Used for error reporting. */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_Obj *errfile = NULL;
    int result, i, j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    Tcl_StatBuf statBuf;
    (void)dummy;

    result = TCL_OK;
    for (i = 1; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    break;
	}
334
335
336
337
338
339
340
341

342
343
344
345
346
347
348

349
350
351
352
353
354
355
337
338
339
340
341
342
343

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359







-
+







+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileDeleteCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* Used for error reporting */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    int i, force, result;
    Tcl_Obj *errfile;
    Tcl_Obj *errorBuffer = NULL;
    (void)dummy;

    i = FileForceOption(interp, objc - 1, objv + 1, &force);
    if (i < 0) {
	return TCL_ERROR;
    }

    errfile = NULL;
942
943
944
945
946
947
948
949

950
951
952
953
954
955
956
957
958
959

960
961
962
963
964
965
966
946
947
948
949
950
951
952

953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971







-
+










+







 *	May set file attributes for the file name.
 *
 *----------------------------------------------------------------------
 */

int
TclFileAttrsCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int objc,			/* Number of command line arguments. */
    Tcl_Obj *const objv[])	/* The command line objects. */
{
    int result;
    const char *const *attributeStrings;
    const char **attributeStringsAllocated = NULL;
    Tcl_Obj *objStrings = NULL;
    int numObjStrings = -1;
    Tcl_Obj *filePtr;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
	return TCL_ERROR;
    }

    filePtr = objv[1];
1158
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1163
1164
1165
1166
1167
1168
1169

1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184







-
+






+







 *	May create a new link.
 *
 *----------------------------------------------------------------------
 */

int
TclFileLinkCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;
    int index;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
	return TCL_ERROR;
    }

    /*
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclFileReadLinkCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;
    (void)dummy;

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

    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
1360
1361
1362
1363
1364
1365
1366
1367

1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380

1381
1382
1383
1384
1385
1386
1387
1367
1368
1369
1370
1371
1372
1373

1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395







-
+













+







 *	to a variable, so reentrancy is a potential issue.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileTemporaryCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *nameVarObj = NULL;	/* Variable to store the name of the temporary
				 * file in. */
    Tcl_Obj *nameObj = NULL;	/* Object that will contain the filename. */
    Tcl_Channel chan;		/* The channel opened (RDWR) on the temporary
				 * file, or NULL if there's an error. */
    Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
				/* Pieces of template. Each piece is NULL if
				 * it is omitted. The platform temporary file
				 * engine might ignore some pieces. */
    (void)dummy;

    if (objc < 1 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
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
1527
1528
1529
1530
1531
1532
1533

1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552







-
+










+







 *	Creates a temporary directory.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileTempDirCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirNameObj;	/* Object that will contain the directory
				 * name. */
    Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL;
				/* Pieces of template. Each piece is NULL if
				 * it is omitted. The platform temporary file
				 * engine might ignore some pieces. */
    (void)dummy;

    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {

Changes to generic/tclFileName.c.

583
584
585
586
587
588
589
590

591
592
593
594
595
596
597
583
584
585
586
587
588
589

590
591
592
593
594
595
596
597







-
+







    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);
    *argvPtr = (const char **)ckalloc((((*argcPtr) + 1) * sizeof(char *)) + size);

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
817
818
819
820
821
822
823
824

825
826
827
828
829
830
831
817
818
819
820
821
822
823

824
825
826
827
828
829
830
831







-
+







	Tcl_Obj *pair[2];

	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = ckalloc(elemc*sizeof(Tcl_Obj *));
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)ckalloc(elemc*sizeof(Tcl_Obj *));

	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	ckfree(elemv);
	return ret;
    }
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251







+







    };
    enum options {
	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
	GLOB_TYPE, GLOB_LAST
    };
    enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
    Tcl_GlobTypeData *globTypes = NULL;
    (void)dummy;

    globFlags = 0;
    join = 0;
    dir = PATH_NONE;
    typePtr = NULL;
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
1445
1446
1447
1448
1449
1450
1451
1452

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

1453
1454
1455
1456
1457
1458
1459
1460







-
+







	 * platform.
	 */

	Tcl_ListObjLength(interp, typePtr, &length);
	if (length <= 0) {
	    goto skipTypes;
	}
	globTypes = TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    int len;
2518
2519
2520
2521
2522
2523
2524
2525

2526
2527
2528
2529
2530
2531
2532
2519
2520
2521
2522
2523
2524
2525

2526
2527
2528
2529
2530
2531
2532
2533







-
+







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

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return ckalloc(sizeof(Tcl_StatBuf));
    return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645
2646
2647
2648
2649
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651







+







unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    return statPtr->st_blksize;
#else
    (void)statPtr;
    /*
     * Not a great guess, but will do...
     */

    return GUESSED_BLOCK_SIZE;
#endif
}

Changes to generic/tclGetDate.y.

956
957
958
959
960
961
962
963

964
965
966
967
968
969
970
971
972

973
974
975
976
977
978
979
956
957
958
959
960
961
962

963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980







-
+









+







	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    void *clientData,	/* Unused */
    void *dummy,	/* Unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of paraneters */
    Tcl_Obj *const *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;
    (void)dummy;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

1070
1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085







-
+







	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,

Changes to generic/tclHash.c.

215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229







-
+







 */

Tcl_HashEntry *
Tcl_FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const void *key)		/* Key to use to find matching entry. */
{
    return (*((tablePtr)->findProc))(tablePtr, key);
    return (*((tablePtr)->findProc))(tablePtr, (const char *)key);
}

static Tcl_HashEntry *
FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
256
257
258
259
260
261
262

263
264
265
266
267
268
269
270







-
+







Tcl_CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const void *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
    return (*((tablePtr)->createProc))(tablePtr, (const char *)key, newPtr);
}

static Tcl_HashEntry *
CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */
344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358







-
+







     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
    } else {
	hPtr = ckalloc(sizeof(Tcl_HashEntry));
	hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
644
645
646
647
648
649
650
651

652
653
654
655
656
657
658
644
645
646
647
648
649
650

651
652
653
654
655
656
657
658







-
+







	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc((NUM_COUNTERS * 60) + 300);
    result = (char *)ckalloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
693
694
695
696
697
698
699
700

701
702
703
704
705
706
707
693
694
695
696
697
698
699

700
701
702
703
704
705
706
707







-
+








    count = tablePtr->keyType;

    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = ckalloc(size);
    hPtr = (Tcl_HashEntry *)ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    hPtr->clientData = 0;

766
767
768
769
770
771
772
773

774
775
776
777
778
779
780

781
782
783
784
785
786
787
766
767
768
769
770
771
772

773
774
775
776
777
778
779

780
781
782
783
784
785
786
787







-
+






-
+








static TCL_HASH_TYPE
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    const int *array = (const int *) keyPtr;
    unsigned int result;
    TCL_HASH_TYPE result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
	result += *array;
    }
    return (TCL_HASH_TYPE) result;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * AllocStringEntry --
 *
799
800
801
802
803
804
805
806


807
808
809
810
811
812

813
814
815
816
817
818
819
799
800
801
802
803
804
805

806
807
808
809
810
811
812

813
814
815
816
817
818
819
820







-
+
+





-
+







static Tcl_HashEntry *
AllocStringEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    unsigned int size, allocsize;
    size_t size, allocsize;
    (void)tablePtr;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = ckalloc(offsetof(Tcl_HashEntry, key) + allocsize);
    hPtr = (Tcl_HashEntry *)ckalloc(offsetof(Tcl_HashEntry, key) + allocsize);
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    hPtr->clientData = 0;
    return hPtr;
}

/*
862
863
864
865
866
867
868
869
870


871

872
873
874
875
876
877
878
863
864
865
866
867
868
869


870
871
872
873
874
875
876
877
878
879
880







-
-
+
+

+







 */

static TCL_HASH_TYPE
HashStringKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    const char *string = keyPtr;
    unsigned int result;
    const char *string = (const char *)keyPtr;
    TCL_HASH_TYPE result;
    char c;
    (void)tablePtr;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
903
904
905
906
907
908
909
910

911
912
913
914
915
916
917
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919







-
+







     */

    if ((result = UCHAR(*string)) != 0) {
	while ((c = *++string) != 0) {
	    result += (result << 3) + UCHAR(c);
	}
    }
    return (TCL_HASH_TYPE) result;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * BogusFind --
 *
929
930
931
932
933
934
935


936
937
938
939
940
941
942
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946







+
+








	/* ARGSUSED */
static Tcl_HashEntry *
BogusFind(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{
    (void)tablePtr;
    (void)key;
    Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
959
960
961
962
963
964
965



966
967
968
969
970
971
972
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979







+
+
+







BogusCreate(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    (void)tablePtr;
    (void)key;
    (void)newPtr;
    Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
1019
1020
1021
1022
1023
1024
1025
1026

1027
1028
1029
1030
1031
1032
1033
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
1040







-
+








    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *), 0);
    } else {
	tablePtr->buckets =
		ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
		(Tcl_HashEntry **)ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->downShift -= 2;

Changes to generic/tclHistory.c.

126
127
128
129
130
131
132
133

134
135
136
137
138
139
140

141
142
143
144
145
146
147
126
127
128
129
130
131
132

133
134
135
136
137
138
139

140
141
142
143
144
145
146
147







-
+






-
+







				 * TCL_EVAL_GLOBAL means evaluate the script
				 * in global variable context instead of the
				 * current procedure. */
{
    int result, call = 1;
    Tcl_CmdInfo info;
    HistoryObjs *histObjsPtr =
	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);
	    (HistoryObjs *)Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = ckalloc(sizeof(HistoryObjs));
	histObjsPtr = (HistoryObjs *)ckalloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }
207
208
209
210
211
212
213
214

215
216


217
218
219
220
221
222
223
224
225
226
227
228
229
207
208
209
210
211
212
213

214
215

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230







-
+

-
+
+













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

static void
DeleteHistoryObjs(
    ClientData clientData,
    Tcl_Interp *interp)
    Tcl_Interp *dummy)
{
    HistoryObjs *histObjsPtr = clientData;
    HistoryObjs *histObjsPtr = (HistoryObjs *)clientData;
    (void)dummy;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    ckfree(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIO.c.

344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
344
345
346
347
348
349
350

351
352
353
354
355
356
357
358







-
+







	Tcl_StoreIntRep((objPtr), &chanObjType, &ir);			\
    } while (0)

#define ChanGetIntRep(objPtr, resPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &chanObjType);		\
	(resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

#define BUSY_STATE(st, fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)
853
854
855
856
857
858
859
860

861
862
863
864
865
866
867
853
854
855
856
857
858
859

860
861
862
863
864
865
866
867







-
+







				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = ckalloc(sizeof(CloseCallback));
    cbPtr = (CloseCallback *)ckalloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}

932
933
934
935
936
937
938
939

940
941

942
943
944
945
946
947
948
932
933
934
935
936
937
938

939
940

941
942
943
944
945
946
947
948







-
+

-
+







static Tcl_HashTable *
GetChannelTable(
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
	hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclIO",
		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);

	/*
	 * If the interpreter is trusted (not "safe"), insert channels for
	 * stdin, stdout and stderr (possibly creating them in the process).
1002
1003
1004
1005
1006
1007
1008
1009

1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
1019







-
+


-
+







				 * to the interpreter being deleted. */

    /*
     * Delete all the registered channels - this will close channels whose
     * refcount reaches zero.
     */

    hTblPtr = clientData;
    hTblPtr = (Tcl_HashTable *)clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = Tcl_GetHashValue(hPtr);
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any fileevents registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
1372
1373
1374
1375
1376
1377
1378
1379

1380
1381
1382
1383
1384
1385
1386
1372
1373
1374
1375
1376
1377
1378

1379
1380
1381
1382
1383
1384
1385
1386







-
+







     * necessary during (un)stack operation.
     */

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    statePtr = chanPtr->state;

    if (interp != NULL) {
	hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
	hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
	if (hTblPtr == NULL) {
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
	if (hPtr == NULL) {
	    return TCL_ERROR;
	}
1475
1476
1477
1478
1479
1480
1481
1482

1483
1484
1485
1486
1487
1488
1489
1475
1476
1477
1478
1479
1480
1481

1482
1483
1484
1485
1486
1487
1488
1489







-
+








    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs
     * compensate where necessary to retrieve the topmost channel again.
     */

    chanPtr = Tcl_GetHashValue(hPtr);
    chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
    chanPtr = chanPtr->state->bottomChanPtr;
    if (modePtr != NULL) {
	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
    }

    return (Tcl_Channel) chanPtr;
}
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531
1532
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533







+







				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    int flags)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;
    (void)flags;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    ChanGetIntRep(objPtr, resPtr);
    if (resPtr) {
1642
1643
1644
1645
1646
1647
1648
1649
1650


1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

1670
1671
1672

1673
1674
1675
1676
1677
1678
1679
1643
1644
1645
1646
1647
1648
1649


1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

1670
1671
1672

1673
1674
1675
1676
1677
1678
1679
1680







-
-
+
+


















-
+


-
+







    }

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    chanPtr = ckalloc(sizeof(Channel));
    statePtr = ckalloc(sizeof(ChannelState));
    chanPtr = (Channel *)ckalloc(sizeof(Channel));
    statePtr = (ChannelState *)ckalloc(sizeof(ChannelState));
    chanPtr->state = statePtr;

    chanPtr->instanceData = instanceData;
    chanPtr->typePtr = typePtr;

    /*
     * Set all the bits that are part of the stack-independent state
     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	tmp = ckalloc((len < 7) ? 7 : len);
	tmp = (char *)ckalloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = ckalloc(7);
	tmp = (char *)ckalloc(7);
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;
    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.
1938
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1939
1940
1941
1942
1943
1944
1945

1946
1947
1948
1949
1950
1951
1952
1953







-
+







	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = ckalloc(sizeof(Channel));
    chanPtr = (Channel *)ckalloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */
2467
2468
2469
2470
2471
2472
2473
2474

2475
2476
2477
2478
2479
2480
2481
2468
2469
2470
2471
2472
2473
2474

2475
2476
2477
2478
2479
2480
2481
2482







-
+







AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = ckalloc(n);
    bufPtr = (ChannelBuffer *)ckalloc(n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
    bufPtr->refCount	= 1;
    return bufPtr;
}
4294
4295
4296
4297
4298
4299
4300
4301

4302
4303
4304
4305
4306
4307
4308
4295
4296
4297
4298
4299
4300
4301

4302
4303
4304
4305
4306
4307
4308
4309







-
+







     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = memchr(src, '\n', srcLen);
	nextNewLine = (char *)memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0) {
	ChannelBuffer *bufPtr;
	char *dst, safe[BUFFER_PADDING];
	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;

4392
4393
4394
4395
4396
4397
4398
4399

4400
4401
4402
4403
4404
4405
4406
4393
4394
4395
4396
4397
4398
4399

4400
4401
4402
4403
4404
4405
4406
4407







-
+








	    bufPtr->nextAdded += dstWrote;
	    src++;
	    srcLen--;
	    total += dstWrote;
	    dst += dstWrote;
	    dstLen -= dstWrote;
	    nextNewLine = memchr(src, '\n', srcLen);
	    nextNewLine = (char *)memchr(src, '\n', srcLen);
	    needNlFlush = 1;
	}

	if (IsBufferOverflowing(bufPtr)) {
	    /*
	     * When translating from UTF-8 to external encoding, we allowed
	     * the translation to produce a character that crossed the end of
5194
5195
5196
5197
5198
5199
5200

5201
5202
5203
5204
5205
5206
5207
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209







+







 */

static void
FreeBinaryEncoding(
    ClientData dummy)	/* Not used */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
}

6499
6500
6501
6502
6503
6504
6505
6506

6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521

6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532

6533
6534
6535
6536
6537
6538
6539
6501
6502
6503
6504
6505
6506
6507

6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522

6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533

6534
6535
6536
6537
6538
6539
6540
6541







-
+














-
+










-
+








    if (inEofChar != '\0') {
	/*
	 * Make sure we do not read past any logical end of channel input
	 * created by the presence of the input eof char.
	 */

	if ((eof = memchr(srcStart, inEofChar, srcLen))) {
	if ((eof = (const char *)memchr(srcStart, inEofChar, srcLen))) {
	    srcLen = eof - srcStart;
	}
    }

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (dstStart != srcStart) {
	    memcpy(dstStart, srcStart, srcLen);
	}
	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
	    char *dst = dstStart;
	    char *dstEnd = dstStart + srcLen;

	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
	    while ((dst = (char *)memchr(dst, '\r', dstEnd - dst))) {
		*dst++ = '\n';
	    }
	}
	dstLen = srcLen;
	break;
    case TCL_TRANSLATE_CRLF: {
	const char *crFound, *src = srcStart;
	char *dst = dstStart;
	int lesser = (dstLen < srcLen) ? dstLen : srcLen;

	while ((crFound = memchr(src, '\r', lesser))) {
	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst += numBytes; dstLen -= numBytes;
	    src += numBytes; srcLen -= numBytes;
	    if (srcLen == 1) {
		/* valid src bytes end in \r */
6565
6566
6567
6568
6569
6570
6571
6572

6573
6574
6575
6576
6577
6578
6579
6567
6568
6569
6570
6571
6572
6573

6574
6575
6576
6577
6578
6579
6580
6581







-
+







	int lesser;

	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
	    if (*src == '\n') { src++; srcLen--; }
	    ResetFlag(statePtr, INPUT_SAW_CR);
	}
	lesser = (dstLen < srcLen) ? dstLen : srcLen;
	while ((crFound = memchr(src, '\r', lesser))) {
	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst[numBytes] = '\n';
	    dst += numBytes + 1; dstLen -= numBytes + 1;
	    src += numBytes + 1; srcLen -= numBytes + 1;
	    if (srcLen == 0) {
8537
8538
8539
8540
8541
8542
8543
8544

8545
8546
8547
8548
8549
8550
8551
8539
8540
8541
8542
8543
8544
8545

8546
8547
8548
8549
8550
8551
8552
8553







-
+







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

static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = clientData;
    Channel *chanPtr = (Channel *)clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
8625
8626
8627
8628
8629
8630
8631
8632

8633
8634
8635
8636
8637
8638
8639
8627
8628
8629
8630
8631
8632
8633

8634
8635
8636
8637
8638
8639
8640
8641







-
+







    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
		(chPtr->clientData == clientData)) {
	    break;
	}
    }
    if (chPtr == NULL) {
	chPtr = ckalloc(sizeof(ChannelHandler));
	chPtr = (ChannelHandler *)ckalloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }
8837
8838
8839
8840
8841
8842
8843
8844

8845
8846
8847
8848
8849
8850
8851
8839
8840
8841
8842
8843
8844
8845

8846
8847
8848
8849
8850
8851
8852
8853







-
+







	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = ckalloc(sizeof(EventScriptRecord));
	esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
8893
8894
8895
8896
8897
8898
8899
8900

8901
8902
8903
8904
8905
8906
8907
8895
8896
8897
8898
8899
8900
8901

8902
8903
8904
8905
8906
8907
8908
8909







-
+







    Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
    Channel *chanPtr;		/* The channel for which this handler is
				 * registered. */
    EventScriptRecord *esPtr;	/* The event script + interpreter to eval it
				 * in. */
    int result;			/* Result of call to eval script. */

    esPtr = clientData;
    esPtr = (EventScriptRecord *)clientData;
    chanPtr = esPtr->chanPtr;
    mask = esPtr->mask;
    interp = esPtr->interp;

    /*
     * We must preserve the interpreter so we can report errors on it later.
     * Note that we do not need to preserve the channel because that is done
8948
8949
8950
8951
8952
8953
8954
8955

8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968

8969
8970
8971
8972
8973
8974
8975
8950
8951
8952
8953
8954
8955
8956

8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978







-
+













+







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

	/* ARGSUSED */
int
Tcl_FileEventObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter in which the channel for which
				 * to create the handler is found. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Channel *chanPtr;		/* The channel to create the handler for. */
    ChannelState *statePtr;	/* State info for channel */
    Tcl_Channel chan;		/* The opaque type for the channel. */
    const char *chanName;
    int modeIndex;		/* Index of mode argument. */
    int mask;
    static const char *const modeOptions[] = {"readable", "writable", NULL};
    static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
    (void)dummy;

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
	    &modeIndex) != TCL_OK) {
9047
9048
9049
9050
9051
9052
9053
9054

9055
9056
9057
9058
9059
9060
9061
9050
9051
9052
9053
9054
9055
9056

9057
9058
9059
9060
9061
9062
9063
9064







-
+







static void
ZeroTransferTimerProc(
    ClientData clientData)
{
    /* calling CopyData with mask==0 still implies immediate invocation of the
     *  -command callback, and completion of the fcopy.
     */
    CopyData(clientData, 0);
    CopyData((CopyState *)clientData, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCopyChannel --
 *
9167
9168
9169
9170
9171
9172
9173
9174

9175
9176
9177
9178
9179
9180
9181
9170
9171
9172
9173
9174
9175
9176

9177
9178
9179
9180
9181
9182
9183
9184







-
+








    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

    csPtr = ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr = (CopyState *)ckalloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
10025
10026
10027
10028
10029
10030
10031
10032

10033
10034
10035
10036
10037
10038
10039
10028
10029
10030
10031
10032
10033
10034

10035
10036
10037
10038
10039
10040
10041
10042







-
+







 */

static void
CopyEventProc(
    ClientData clientData,
    int mask)
{
    (void) CopyData(clientData, mask);
    (void) CopyData((CopyState *)clientData, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *
10358
10359
10360
10361
10362
10363
10364
10365

10366
10367
10368
10369
10370
10371
10372
10361
10362
10363
10364
10365
10366
10367

10368
10369
10370
10371
10372
10373
10374
10375







-
+







     * Always check bottom-most channel in the stack. This is the one that
     * gets registered.
     */

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    statePtr = chanPtr->state;

    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	return 0;
    }
    hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
    if (hPtr == NULL) {
	return 0;
    }
11032
11033
11034
11035
11036
11037
11038
11039

11040
11041
11042
11043
11044
11045
11046
11035
11036
11037
11038
11039
11040
11041

11042
11043
11044
11045
11046
11047
11048
11049







-
+







    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = ckalloc(lcn * sizeof(Tcl_Obj *));
    lvn = (Tcl_Obj **)ckalloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */

Changes to generic/tclIOCmd.c.

67
68
69
70
71
72
73
74

75
76

77
78
79
80
81
82
83
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84







-
+


+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeIOCmdTSD(
    ClientData clientData)	/* Not used. */
    ClientData dummy)	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (tsdPtr->stdoutObjPtr != NULL) {
	Tcl_DecrRefCount(tsdPtr->stdoutObjPtr);
	tsdPtr->stdoutObjPtr = NULL;
    }
    tsdPtr->initialized = 0;
}
109
110
111
112
113
114
115

116
117
118
119
120
121
122
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124







+







{
    Tcl_Channel chan;		/* The channel to puts on. */
    Tcl_Obj *string;		/* String to write. */
    Tcl_Obj *chanObjPtr = NULL;	/* channel object. */
    int newline;		/* Add a newline at end? */
    int result;			/* Result of puts operation. */
    int mode;			/* Mode in which channel is opened. */
    (void)dummy;

    switch (objc) {
    case 2:			/* [puts $x] */
	string = objv[1];
	newline = 1;
	break;

233
234
235
236
237
238
239

240
241
242
243
244
245
246
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *chanObjPtr;
    Tcl_Channel chan;		/* The channel to flush on. */
    int mode;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
300
301
302
303
304
305
306

307
308
309
310
311
312
313
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;
    int code = TCL_OK;
    (void)dummy;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
386
387
388
389
390
391
392

393
394
395
396
397
398
399
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404







+







{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    int toRead;			/* How many bytes to read? */
    int charactersRead;		/* How many characters were read? */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *resultPtr, *chanObjPtr;
    (void)dummy;

    if ((objc != 2) && (objc != 3)) {
	Interp *iPtr;

    argerror:
	iPtr = (Interp *) interp;
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?numChars?");
519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
534
535
536
537
538
539

540
541
542
543
544
545
546
524
525
526
527
528
529
530

531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552







-
+













+







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

	/* ARGSUSED */
int
Tcl_SeekObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt offset;		/* Where to seek? */
    int mode;			/* How to seek? */
    Tcl_WideInt result;		/* Of calling Tcl_Seek. */
    int optionIndex;
    static const char *const originOptions[] = {
	"start", "current", "end", NULL
    };
    static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
    (void)dummy;

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
595
596
597
598
599
600
601
602

603
604
605
606
607
608
609

610
611
612
613
614
615
616
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623







-
+







+







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

	/* ARGSUSED */
int
Tcl_TellObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt newLoc;
    int code;
    (void)dummy;

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

    /*
658
659
660
661
662
663
664
665

666
667
668
669
670
671
672
673
674

675
676
677
678
679
680
681
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689







-
+









+







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

	/* ARGSUSED */
int
Tcl_CloseObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to close. */
    static const char *const dirOptions[] = {
	"read", "write", NULL
    };
    static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
    (void)dummy;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
767
768
769
770
771
772
773
774

775
776
777
778
779
780
781

782
783
784
785
786
787
788
775
776
777
778
779
780
781

782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797







-
+







+







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

	/* ARGSUSED */
int
Tcl_FconfigureObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *optionName, *valueName;
    Tcl_Channel chan;		/* The channel to set a mode on. */
    int i;			/* Iterate over arg-value pairs. */
    (void)dummy;

    if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
843
844
845
846
847
848
849
850

851
852
853
854
855

856
857
858
859
860
861
862
852
853
854
855
856
857
858

859
860
861
862
863
864
865
866
867
868
869
870
871
872







-
+





+







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

	/* ARGSUSED */
int
Tcl_EofObjCmd(
    ClientData unused,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    (void)dummy;

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

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
901
902
903
904
905
906
907

908
909
910
911
912
913
914
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925







+







    int ignoreStderr;
    static const char *const options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum options {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };
    (void)dummy;

    /*
     * Check for any leading option arguments.
     */

    keepNewline = 0;
    ignoreStderr = 0;
948
949
950
951
952
953
954
955

956
957
958
959
960
961
962
959
960
961
962
963
964
965

966
967
968
969
970
971
972
973







-
+








    /*
     * Create the string argument array "argv". Make sure argv is large enough
     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
     */

    argc = objc - skip;
    argv = TclStackAlloc(interp, (argc + 1) * sizeof(char *));
    argv = (const char **)TclStackAlloc(interp, (argc + 1) * sizeof(char *));

    /*
     * Copy the string conversions of each (post option) object into the
     * argument vector.
     */

    for (i = 0; i < argc; i++) {
1051
1052
1053
1054
1055
1056
1057
1058

1059
1060
1061
1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1062
1063
1064
1065
1066
1067
1068

1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083







-
+






+







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

	/* ARGSUSED */
int
Tcl_FblockedObjCmd(
    ClientData unused,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int mode;
    (void)dummy;

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

    if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
1098
1099
1100
1101
1102
1103
1104
1105

1106
1107
1108
1109
1110
1111
1112

1113
1114
1115
1116
1117
1118
1119
1110
1111
1112
1113
1114
1115
1116

1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132







-
+







+







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

	/* ARGSUSED */
int
Tcl_OpenObjCmd(
    ClientData notUsed,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int pipeline, prot;
    const char *modeString, *what;
    Tcl_Channel chan;
    (void)dummy;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?");
	return TCL_ERROR;
    }
    prot = 0666;
    if (objc == 2) {
1224
1225
1226
1227
1228
1229
1230
1231

1232
1233

1234
1235

1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1237
1238
1239
1240
1241
1242
1243

1244
1245

1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258
1259
1260







-
+

-
+


+



-
+







 */

	/* ARGSUSED */
static void
TcpAcceptCallbacksDeleteProc(
    ClientData clientData,	/* Data which was passed when the assocdata
				 * was registered. */
    Tcl_Interp *interp)		/* Interpreter being deleted - not used. */
    Tcl_Interp *dummy)		/* Interpreter being deleted - not used. */
{
    Tcl_HashTable *hTblPtr = clientData;
    Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    (void)dummy;

    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    ckfree(hTblPtr);
}

1274
1275
1276
1277
1278
1279
1280
1281

1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305







-
+


-
+







{
    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback records to
				 * smash when the interpreter will be
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = ckalloc(sizeof(Tcl_HashTable));
	hTblPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    if (!isNew) {
1320
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1334
1335
1336
1337
1338
1339
1340

1341
1342
1343
1344
1345
1346
1347
1348







-
+







    AcceptCallback *acceptCallbackPtr)
				/* The record for which to delete the
				 * registration. */
{
    Tcl_HashTable *hTblPtr;
    Tcl_HashEntry *hPtr;

    hTblPtr = Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
    if (hTblPtr == NULL) {
	return;
    }

    hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
    if (hPtr != NULL) {
	Tcl_DeleteHashEntry(hPtr);
1358
1359
1360
1361
1362
1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1372
1373
1374
1375
1376
1377
1378

1379
1380
1381
1382
1383
1384
1385
1386







-
+







				 * created in the call to
				 * Tcl_OpenTcpServer. */
    Tcl_Channel chan,		/* Channel for the newly accepted
				 * connection. */
    char *address,		/* Address of client that was accepted. */
    int port)			/* Port of client that was accepted. */
{
    AcceptCallback *acceptCallbackPtr = callbackData;
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;

    /*
     * Check if the callback is still valid; the interpreter may have gone
     * away, this is signalled by setting the interp field of the callback
     * data to NULL.
     */

1444
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455
1456
1457
1458
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
1472







-
+







 */

static void
TcpServerCloseProc(
    ClientData callbackData)	/* The data passed in the call to
				 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr = callbackData;
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
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
1501
1502
1503
1504
1505
1506
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521







-
+


















+







 *	Creates a socket based channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SocketObjCmd(
    ClientData notUsed,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
	NULL
    };
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
	reusea = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    Tcl_Channel chan;
    (void)dummy;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
	const char *arg = Tcl_GetString(objv[a]);
1648
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669

1670
1671
1672
1673
1674
1675
1676
1677







-
+







    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
1727
1728
1729
1730
1731
1732
1733

1734
1735
1736
1737
1738
1739
1740
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756







+







{
    Tcl_Channel inChan, outChan;
    int mode, i, index;
    Tcl_WideInt toRead;
    Tcl_Obj *cmdPtr;
    static const char *const switches[] = { "-size", "-command", NULL };
    enum { FcopySize, FcopyCommand };
    (void)dummy;

    if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"input output ?-size size? ?-command callback?");
	return TCL_ERROR;
    }

1812
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1827

1828
1829
1830
1831
1832
1833
1834
1828
1829
1830
1831
1832
1833
1834

1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851







-
+








+







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

	/* ARGSUSED */
static int
ChanPendingObjCmd(
    ClientData unused,		/* Not used. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int index, mode;
    static const char *const options[] = {"input", "output", NULL};
    enum options {PENDING_INPUT, PENDING_OUTPUT};
    (void)dummy;

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

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
1881
1882
1883
1884
1885
1886
1887

1888
1889
1890
1891
1892
1893
1894
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    Tcl_WideInt length;
    (void)dummy;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?length?");
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
1955
1956
1957
1958
1959
1960
1961

1962
1963
1964
1965
1966
1967
1968
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel rchan, wchan;
    const char *channelNames[2];
    Tcl_Obj *resultPtr;
    (void)dummy;

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

    if (Tcl_CreatePipe(interp, &rchan, &wchan, 0) != TCL_OK) {
1998
1999
2000
2001
2002
2003
2004
2005

2006
2007
2008
2009

2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036







-
+




+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclChannelNamesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;
    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }
    return Tcl_GetChannelNamesEx(interp,
	    ((objc == 1) ? NULL : TclGetString(objv[1])));
}

Changes to generic/tclIOGT.c.

283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
283
284
285
286
287
288
289

290
291
292
293
294
295
296
297







-
+








    /*
     * Now initialize the transformation state and stack it upon the specified
     * channel. One of the necessary things to do is to retrieve the blocking
     * regime of the underlying channel and to use the same for us too.
     */

    dataPtr = ckalloc(sizeof(TransformChannelData));
    dataPtr = (TransformChannelData *)ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;
499
500
501
502
503
504
505
506

507
508
509
510
511
512
513
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+







 */

static int
TransformBlockModeProc(
    ClientData instanceData,	/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {
	dataPtr->flags &= ~CHANNEL_ASYNC;
    }
    return 0;
531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+







 */

static int
TransformCloseProc(
    ClientData instanceData,
    Tcl_Interp *interp)
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Important: In this procedure 'dataPtr->self' already points to the
     * underlying channel.
     *
     * There is no need to cancel an existing channel handler, this is already
     * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626







-
+







static int
TransformInputProc(
    ClientData instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    int gotBytes, read, copied;
    Tcl_Channel downChan;

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

779
780
781
782
783
784
785
786

787
788
789
790
791
792
793
779
780
781
782
783
784
785

786
787
788
789
790
791
792
793







-
+







static int
TransformOutputProc(
    ClientData instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Should assert(dataPtr->mode & TCL_WRITABLE);
     */

    if (toWrite == 0) {
	/*
831
832
833
834
835
836
837
838

839
840
841
842
843
844
845
831
832
833
834
835
836
837

838
839
840
841
842
843
844
845







-
+







static int
TransformSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    long offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);

    if ((offset == 0) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
898
899
900
901
902
903
904
905

906
907
908
909
910
911
912
898
899
900
901
902
903
904

905
906
907
908
909
910
911
912







-
+







static Tcl_WideInt
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    Tcl_WideInt offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

990
991
992
993
994
995
996
997

998
999
1000
1001
1002
1003
1004
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1004







-
+







static int
TransformSetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverSetOptionProc *setOptionProc;

    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
    if (setOptionProc == NULL) {
	return TCL_ERROR;
    }
1028
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1028
1029
1030
1031
1032
1033
1034

1035
1036
1037
1038
1039
1040
1041
1042







-
+







static int
TransformGetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
	return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
		optionName, dsPtr);
1074
1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087
1088







-
+








	/* ARGSUSED */
static void
TransformWatchProc(
    ClientData instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occuring for this channel. We
     * are forwarding the call to the underlying channel now.
     */

1153
1154
1155
1156
1157
1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
1167







-
+








static int
TransformGetFileHandleProc(
    ClientData instanceData,	/* Channel to query. */
    int direction,		/* Direction of interest. */
    ClientData *handlePtr)	/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = instanceData;
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */

    return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1187
1188
1189
1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1201







-
+








static int
TransformNotifyProc(
    ClientData clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occuring events. */
{
    TransformChannelData *dataPtr = clientData;
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    /*
     * An event occured in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */

    if (dataPtr->timer != NULL) {
1230
1231
1232
1233
1234
1235
1236
1237

1238
1239
1240
1241
1242
1243
1244
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1244







-
+







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

static void
TransformChannelHandlerTimer(
    ClientData clientData)	/* Transformation to query. */
{
    TransformChannelData *dataPtr = clientData;
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the
	 * events it generates or nothing is available for reading, so ignore
	 * it and don't recreate it.
1412
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422

1423
1424
1425
1426
1427
1428
1429
1412
1413
1414
1415
1416
1417
1418

1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
1429







-
+


-
+







    if (r->used + toWrite > r->allocated) {
	/*
	 * Extension of the internal buffer is required.
	 */

	if (r->allocated == 0) {
	    r->allocated = toWrite + INCREMENT;
	    r->buf = ckalloc(r->allocated);
	    r->buf = (unsigned char *)ckalloc(r->allocated);
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = ckrealloc(r->buf, r->allocated);
	    r->buf = (unsigned char *)ckrealloc(r->buf, r->allocated);
	}
    }

    /*
     * Now we may copy the data.
     */

Changes to generic/tclIORChan.c.

488
489
490
491
492
493
494
495

496
497
498
499
500
501
502
488
489
490
491
492
493
494

495
496
497
498
499
500
501
502







-
+







 *	Creates a new channel.
 *
 *----------------------------------------------------------------------
 */

int
TclChanCreateObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    ReflectedChannel *rcPtr;	/* Instance data of the new channel */
    Tcl_Obj *rcId;		/* Handle of the new channel */
    int mode;			/* R/W mode of new channel. Has to match
514
515
516
517
518
519
520

521
522
523
524
525
526
527
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528







+







    Channel *chanPtr;		/* 'chan' resolved to internal struct. */
    Tcl_Obj *err;		/* Error message */
    ReflectedChannelMap *rcmPtr;
				/* Map of reflected channels with handlers in
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    int isNew;			/* Placeholder. */
    (void)dummy;

    /*
     * Syntax:   chan create MODE CMDPREFIX
     *           [0]  [1]    [2]  [3]
     *
     * Actually: rCreate MODE CMDPREFIX
     *           [0]     [1]  [2]
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692







-
+







    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
	/*
	 * Some of the nullable methods are not supported. We clone the
	 * channel type, null the associated C functions, and use the result
	 * as the actual channel type.
	 */

	Tcl_ChannelType *clonePtr = ckalloc(sizeof(Tcl_ChannelType));
	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType));

	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));

	if (!(methods & FLAG(METH_CONFIGURE))) {
	    clonePtr->setOptionProc = NULL;
	}

777
778
779
780
781
782
783

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







+







     *
     * Note: When the channel is closed any pending events of this type are
     * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
     * accomplishing that.
     */

    ReflectEvent *e = (ReflectEvent *) ev;
    (void)flags;

    Tcl_NotifyChannel(e->rcPtr->chan, e->events);
    return 1;
}

static int
ReflectEventDelete(
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
807
808
809
810
811
812
813

814
815
816
817
818
819
820
821







-
+







    }
    return 1;
}
#endif

int
TclChanPostEventObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Ensure -> HANDLER thread
     *
834
835
836
837
838
839
840

841
842
843
844
845
846
847
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850







+







    const Tcl_ChannelType *chanTypePtr;
				/* Its associated driver structure */
    ReflectedChannel *rcPtr;	/* Associated instance data */
    int events;			/* Mask of events to post */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    (void)dummy;

    /*
     * Number of arguments...
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
878
879
880
881
882
883
884
885

886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901

902
903
904
905
906
907
908
881
882
883
884
885
886
887

888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903

904
905
906
907
908
909
910
911







-
+















-
+







     * defined in this interpreter.
     *
     * We keep the old checks for both, for paranioa, but abort now instead of
     * throwing errors, as failure now means that our internal datastructures
     * have gone seriously haywire.
     */

    chan = Tcl_GetHashValue(hPtr);
    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
    chanTypePtr = Tcl_GetChannelType(chan);

    /*
     * We use a function referenced by the channel type as our cookie to
     * detect calls to non-reflecting channels. The channel type itself is not
     * suitable, as it might not be the static definition in this file, but a
     * clone thereof. And while we have reserved the name of the type nothing
     * in the core checks against violation, so someone else might have
     * created a channel type using our name, clashing with ourselves.
     */

    if (chanTypePtr->watchProc != &ReflectWatch) {
	Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel");
    }

    rcPtr = Tcl_GetChannelInstanceData(chan);
    rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

    if (rcPtr->interp != interp) {
	Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
    }

    /*
     * Second argument is a list of events. Allowed entries are "read",
941
942
943
944
945
946
947
948

949
950
951
952
953
954
955
944
945
946
947
948
949
950

951
952
953
954
955
956
957
958







-
+







	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
        ReflectEvent *ev = (ReflectEvent *)ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

        /*
         * We are not preserving the structure here. When the channel is
990
991
992
993
994
995
996
997

998
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
993
994
995
996
997
998
999

1000
1001
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015
1016







-
+








-
+







#undef EVENT
}

static void
TimerRunRead(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->readTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}

static void
TimerRunWrite(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->writeTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}

/*
 * Channel error message marshalling utilities.
 */
1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1151
1152
1153
1154
1155
1156
1157

1158
1159
1160
1161
1162
1163
1164
1165







-
+







 */

static int
ReflectClose(
    ClientData clientData,
    Tcl_Interp *interp)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    int result;			/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
				 * this interp */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    const Tcl_ChannelType *tctPtr;

1305
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322







-
+







static int
ReflectInput(
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *toReadObj;
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
1412
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425
1426
1415
1416
1417
1418
1419
1420
1421

1422
1423
1424
1425
1426
1427
1428
1429







-
+







static int
ReflectOutput(
    ClientData clientData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * Are we in the correct thread?
     */
1541
1542
1543
1544
1545
1546
1547
1548

1549
1550
1551
1552
1553
1554
1555
1544
1545
1546
1547
1548
1549
1550

1551
1552
1553
1554
1555
1556
1557
1558







-
+







static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *offObj, *baseObj;
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;

    /*
     * Are we in the correct thread?
     */
1650
1651
1652
1653
1654
1655
1656
1657

1658
1659
1660
1661
1662
1663
1664
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662
1663
1664
1665
1666
1667







-
+







 */

static void
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *maskObj;

    /*
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */
1722
1723
1724
1725
1726
1727
1728
1729

1730
1731
1732
1733
1734
1735
1736
1725
1726
1727
1728
1729
1730
1731

1732
1733
1734
1735
1736
1737
1738
1739







-
+







 */

static int
ReflectBlock(
    ClientData clientData,
    int nonblocking)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *blockObj;
    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result data for 'blocking' */

    /*
     * Are we in the correct thread?
     */
1789
1790
1791
1792
1793
1794
1795
1796

1797
1798
1799
1800
1801
1802
1803
1792
1793
1794
1795
1796
1797
1798

1799
1800
1801
1802
1803
1804
1805
1806







-
+







 */

static void
ReflectThread(
    ClientData clientData,
    int action)
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;

    switch (action) {
    case TCL_CHANNEL_THREAD_INSERT:
        rcPtr->owner = Tcl_GetCurrentThread();
        break;
    case TCL_CHANNEL_THREAD_REMOVE:
        rcPtr->owner = NULL;
1828
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
1831
1832
1833
1834
1835
1836
1837

1838
1839
1840
1841
1842
1843
1844
1845







-
+







static int
ReflectSetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    const char *newValue)	/* The new value */
{
    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *optionObj, *valueObj;
    int result;			/* Result code for 'configure' */
    Tcl_Obj *resObj;		/* Result data for 'configure' */

    /*
     * Are we in the correct thread?
     */
1905
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928
1929
1930
1931
1932
1908
1909
1910
1911
1912
1913
1914

1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927

1928
1929
1930
1931
1932
1933
1934
1935







-
+












-
+







    Tcl_DString *dsPtr)		/* String to place the result into */
{
    /*
     * This code is special. It has regular passing of Tcl result, and errors.
     * The bypass functions are not required.
     */

    ReflectedChannel *rcPtr = clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    int listc, result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	int opcode;
	ForwardedOperation opcode;
	ForwardParam p;

	p.getOpt.name = optionName;
	p.getOpt.value = dsPtr;

	if (optionName == NULL) {
	    opcode = ForwardedGetOptAll;
2170
2171
2172
2173
2174
2175
2176
2177

2178
2179

2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198

2199
2200
2201
2202
2203
2204
2205
2173
2174
2175
2176
2177
2178
2179

2180
2181

2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200

2201
2202
2203
2204
2205
2206
2207
2208







-
+

-
+


















-
+







NewReflectedChannel(
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    MethodName mn = METH_BLOCKING;
    int mn = 0;

    rcPtr = ckalloc(sizeof(ReflectedChannel));
    rcPtr = (ReflectedChannel *)ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
    rcPtr->readTimer = 0;
    rcPtr->writeTimer = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= METH_WRITE) {
    while (mn <= (int)METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
    rcPtr->name = handleObj;
    Tcl_IncrRefCount(rcPtr->name);
    return rcPtr;
2492
2493
2494
2495
2496
2497
2498
2499

2500
2501
2502

2503
2504
2505
2506
2507
2508
2509
2495
2496
2497
2498
2499
2500
2501

2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
2512







-
+


-
+







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

static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
	rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}

2550
2551
2552
2553
2554
2555
2556
2557

2558
2559
2560
2561
2562
2563
2564
2553
2554
2555
2556
2557
2558
2559

2560
2561
2562
2563
2564
2565
2566
2567







-
+







}

static void
DeleteReflectedChannelMap(
    ClientData clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedChannelMap *rcmPtr = clientData;
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
				/* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedChannel *rcPtr;
    Tcl_Channel chan;
#if TCL_THREADS
    ForwardingResult *resultPtr;
2577
2578
2579
2580
2581
2582
2583
2584
2585


2586
2587
2588
2589
2590
2591
2592
2580
2581
2582
2583
2584
2585
2586


2587
2588
2589
2590
2591
2592
2593
2594
2595







-
-
+
+







     * DeleteThreadReflectedChannelMap(), just restricted to the channels of
     * this interp.
     */

    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	chan = Tcl_GetHashValue(hPtr);
	rcPtr = Tcl_GetChannelInstanceData(chan);
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    ckfree(&rcmPtr->map);

2655
2656
2657
2658
2659
2660
2661
2662
2663


2664
2665
2666
2667
2668
2669
2670
2658
2659
2660
2661
2662
2663
2664


2665
2666
2667
2668
2669
2670
2671
2672
2673







-
-
+
+







     * interpreter. They have already been marked as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	chan = Tcl_GetHashValue(hPtr);
	rcPtr = Tcl_GetChannelInstanceData(chan);
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	if (rcPtr->interp != interp) {
	    /*
	     * Ignore entries for other interpreters.
	     */

	    continue;
2696
2697
2698
2699
2700
2701
2702
2703

2704
2705
2706
2707
2708
2709
2710
2699
2700
2701
2702
2703
2704
2705

2706
2707
2708
2709
2710
2711
2712
2713







-
+








static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = ckalloc(sizeof(ReflectedChannelMap));
	tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}

2724
2725
2726
2727
2728
2729
2730
2731

2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2727
2728
2729
2730
2731
2732
2733

2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748







-
+






+







 *	Deletes the hash table of channels.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteThreadReflectedChannelMap(
    ClientData clientData)	/* The per-thread data structure. */
    ClientData dummy)	/* The per-thread data structure. */
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ReflectedChannelMap *rcmPtr; /* The map */
    ForwardingResult *resultPtr;
    (void)dummy;

    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedChannelMap is apparently not called.
     */

2813
2814
2815
2816
2817
2818
2819
2820
2821


2822
2823
2824
2825
2826
2827
2828
2817
2818
2819
2820
2821
2822
2823


2824
2825
2826
2827
2828
2829
2830
2831
2832







-
-
+
+







     * through the channels, remove all, mark them as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = Tcl_GetChannelInstanceData(chan);
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(rcmPtr);
}

2859
2860
2861
2862
2863
2864
2865
2866
2867


2868
2869
2870
2871
2872
2873
2874
2863
2864
2865
2866
2867
2868
2869


2870
2871
2872
2873
2874
2875
2876
2877
2878







-
-
+
+







	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = ckalloc(sizeof(ForwardingEvent));
    resultPtr = ckalloc(sizeof(ForwardingResult));
    evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rcPtr = rcPtr;
    evPtr->param = (ForwardParam *) param;

2977
2978
2979
2980
2981
2982
2983

2984
2985
2986
2987
2988
2989
2990
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995







+







    ReflectedChannel *rcPtr = evPtr->rcPtr;
    Tcl_Interp *interp = rcPtr->interp;
    ForwardParam *paramPtr = evPtr->param;
    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
                                 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    (void)mask;

    /*
     * Ignore the event if no one is waiting for its result anymore.
     */

    if (!resultPtr) {
	return 1;
3237
3238
3239
3240
3241
3242
3243
3244

3245
3246
3247
3248
3249
3250
3251
3242
3243
3244
3245
3246
3247
3248

3249
3250
3251
3252
3253
3254
3255
3256







-
+







		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = ckalloc(200);
		char *buf = (char *)ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		int len;
3294
3295
3296
3297
3298
3299
3300
3301

3302
3303
3304
3305
3306
3307
3308
3299
3300
3301
3302
3303
3304
3305

3306
3307
3308
3309
3310
3311
3312
3313







-
+







    return 1;
}

static void
SrcExitProc(
    ClientData clientData)
{
    ForwardingEvent *evPtr = clientData;
    ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
    ForwardingResult *resultPtr;
    ForwardParam *paramPtr;

    /*
     * NOTE (2): Can this handler be called with the originator blocked?
     */

Changes to generic/tclIORTrans.c.

493
494
495
496
497
498
499
500

501
502
503
504
505
506
507
493
494
495
496
497
498
499

500
501
502
503
504
505
506
507







-
+







 *	Creates a new channel.
 *
 *----------------------------------------------------------------------
 */

int
TclChanPushObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    ReflectedTransform *rtPtr;	/* Instance data of the new (transform)
				 * channel. */
    Tcl_Obj *chanObj;		/* Handle of parent channel */
520
521
522
523
524
525
526

527
528
529
530
531
532
533
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534







+







    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
				 * in this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    int isNew;			/* Placeholder. */
    (void)dummy;

    /*
     * Syntax:   chan push CHANNEL CMDPREFIX
     *           [0]  [1]  [2]     [3]
     *
     * Actually: rPush CHANNEL CMDPREFIX
     *           [0]   [1]     [2]
738
739
740
741
742
743
744
745

746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762

763
764
765
766
767
768
769
739
740
741
742
743
744
745

746
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







-
+

















+







 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

int
TclChanPopObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Syntax:   chan pop CHANNEL
     *           [0]  [1] [2]
     *
     * Actually: rPop CHANNEL
     *           [0]  [1]
     */

#define CHAN	(1)

    const char *chanId;		/* Tcl level channel handle */
    Tcl_Channel chan;		/* Channel associated to the handle */
    int mode;			/* Channel r/w mode */
    (void)dummy;

    /*
     * Number of arguments...
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
877
878
879
880
881
882
883
884

885
886
887
888
889
890
891
879
880
881
882
883
884
885

886
887
888
889
890
891
892
893







-
+







 */

static int
ReflectClose(
    ClientData clientData,
    Tcl_Interp *interp)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    int errorCode, errorCodeSet = 0;
    int result = TCL_OK;	/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
				 * in this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1069







-
+







static int
ReflectInput(
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    int gotBytes, copied, readBytes;
    Tcl_Obj *bufObj;

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
1246
1247
1248
1249
1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260
1248
1249
1250
1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261
1262







-
+







static int
ReflectOutput(
    ClientData clientData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
     */

1319
1320
1321
1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1335







-
+







static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Channel *parent = (Channel *) rtPtr->parent;
    Tcl_WideInt curPos;		/* Position on the device. */

    Tcl_DriverSeekProc *seekProc =
	    Tcl_ChannelSeekProc(Tcl_GetChannelType(rtPtr->parent));

    /*
1438
1439
1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1440
1441
1442
1443
1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454







-
+







 */

static void
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Tcl_DriverWatchProc *watchProc;

    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent));
    watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask);

    /*
     * Management of the internal timer.
1489
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503
1504
1505







-
+







 */

static int
ReflectBlock(
    ClientData clientData,
    int nonblocking)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations simply record the blocking mode in their C level
     * structure for use by --> ReflectInput. The Tcl level doesn't see this
     * information or change. As such thread forwarding is not required.
     */

1524
1525
1526
1527
1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540







-
+







static int
ReflectSetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    const char *newValue)	/* The new value */
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back
     * unchanged as well. This all happens in the thread we are in. As the Tcl
     * level is not involved there is no need for thread forwarding.
     */
1566
1567
1568
1569
1570
1571
1572
1573

1574
1575
1576
1577
1578
1579
1580
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578
1579
1580
1581
1582







-
+







static int
ReflectGetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of reuqested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back
     * unchanged as well. This all happens in the thread we are in. As the Tcl
     * level is not involved there is no need for thread forwarding.
     *
1614
1615
1616
1617
1618
1619
1620
1621

1622
1623
1624
1625
1626
1627
1628
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629
1630







-
+








static int
ReflectHandle(
    ClientData clientData,
    int direction,
    ClientData *handlePtr)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no handle of their own. As such we simply query
     * the parent channel for it. This way the qery will ripple down through
     * all transformations until reaches the base channel. Which then returns
     * its handle, or fails. The former will then ripple up the stack.
     *
1649
1650
1651
1652
1653
1654
1655
1656

1657
1658
1659
1660
1661
1662
1663
1651
1652
1653
1654
1655
1656
1657

1658
1659
1660
1661
1662
1663
1664
1665







-
+







 */

static int
ReflectNotify(
    ClientData clientData,
    int mask)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * An event occured in the underlying channel.
     *
     * We delete our timer. It was not fired, yet we are here, so the channel
     * below generated such an event and we don't have to. The renewal of the
     * interest after the execution of channel handlers will eventually cause
1749
1750
1751
1752
1753
1754
1755

1756
1757

1758
1759
1760
1761
1762
1763
1764
1751
1752
1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1767







+

-
+







    Tcl_Obj *handleObj,
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    int listc;
    Tcl_Obj **listv;
    int i;
    (void)mode;

    rtPtr = ckalloc(sizeof(ReflectedTransform));
    rtPtr = (ReflectedTransform *)ckalloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS
1797
1798
1799
1800
1801
1802
1803
1804

1805
1806
1807
1808
1809
1810
1811
1800
1801
1802
1803
1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814







-
+







     *
     * listv [0] [listc-1] | [listc]  [listc+1] |
     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
     *       cmd   ... pfx | method   chan      | detail1 detail2
     */

    rtPtr->argc = listc + 2;
    rtPtr->argv = ckalloc(sizeof(Tcl_Obj *) * (listc+4));
    rtPtr->argv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * (listc+4));

    /*
     * Duplicate object references.
     */

    for (i=0; i<listc ; i++) {
	Tcl_Obj *word = rtPtr->argv[i] = listv[i];
2102
2103
2104
2105
2106
2107
2108
2109

2110
2111
2112

2113
2114
2115
2116
2117
2118
2119
2105
2106
2107
2108
2109
2110
2111

2112
2113
2114

2115
2116
2117
2118
2119
2120
2121
2122







-
+


-
+







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

static ReflectedTransformMap *
GetReflectedTransformMap(
    Tcl_Interp *interp)
{
    ReflectedTransformMap *rtmPtr = Tcl_GetAssocData(interp, RTMKEY, NULL);
    ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL);

    if (rtmPtr == NULL) {
	rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
	rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RTMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
    }
    return rtmPtr;
}

2160
2161
2162
2163
2164
2165
2166
2167

2168
2169
2170
2171

2172
2173
2174
2175
2176
2177
2178
2163
2164
2165
2166
2167
2168
2169

2170
2171
2172
2173

2174
2175
2176
2177
2178
2179
2180
2181







-
+



-
+







     * systems point of view and will not get closed. Therefore mark all as
     * dead so that any future access will cause a proper error. For channels
     * in a different thread we actually do the same as
     * DeleteThreadReflectedTransformMap(), just restricted to the channels of
     * this interp.
     */

    rtmPtr = clientData;
    rtmPtr = (ReflectedTransformMap *)clientData;
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	rtPtr = Tcl_GetHashValue(hPtr);
	rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    ckfree(&rtmPtr->map);

2188
2189
2190
2191
2192
2193
2194
2195

2196
2197
2198
2199
2200
2201
2202
2191
2192
2193
2194
2195
2196
2197

2198
2199
2200
2201
2202
2203
2204
2205







-
+







     * interpreter. They have already been marked as dead.
     */

    rtmPtr = GetThreadReflectedTransformMap();
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	rtPtr = Tcl_GetHashValue(hPtr);
	rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	if (rtPtr->interp != interp) {
	    /*
	     * Ignore entries for other interpreters.
	     */

	    continue;
2268
2269
2270
2271
2272
2273
2274
2275

2276
2277
2278
2279
2280
2281
2282
2271
2272
2273
2274
2275
2276
2277

2278
2279
2280
2281
2282
2283
2284
2285







-
+








static ReflectedTransformMap *
GetThreadReflectedTransformMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rtmPtr) {
	tsdPtr->rtmPtr = ckalloc(sizeof(ReflectedTransformMap));
	tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
    }

    return tsdPtr->rtmPtr;
}

2296
2297
2298
2299
2300
2301
2302
2303

2304
2305
2306
2307
2308
2309

2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327

2328
2329
2330
2331
2332
2333
2334
2299
2300
2301
2302
2303
2304
2305

2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330

2331
2332
2333
2334
2335
2336
2337
2338







-
+






+

















-
+







 *	Deletes the hash table of channels.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteThreadReflectedTransformMap(
    ClientData clientData)	/* The per-thread data structure. */
    ClientData dummy)	/* The per-thread data structure. */
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ReflectedTransformMap *rtmPtr; /* The map */
    ForwardingResult *resultPtr;
    (void)dummy;

    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedTransformMap is apparently not called.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
     * through the channels, remove all, mark them as dead.
     */

    rtmPtr = GetThreadReflectedTransformMap();
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	ReflectedTransform *rtPtr = Tcl_GetHashValue(hPtr);
	ReflectedTransform *rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    ckfree(rtmPtr);

2403
2404
2405
2406
2407
2408
2409
2410
2411


2412
2413
2414
2415
2416
2417
2418
2407
2408
2409
2410
2411
2412
2413


2414
2415
2416
2417
2418
2419
2420
2421
2422







-
-
+
+







	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = ckalloc(sizeof(ForwardingEvent));
    resultPtr = ckalloc(sizeof(ForwardingResult));
    evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rtPtr = rtPtr;
    evPtr->param = (ForwardParam *) param;

2515
2516
2517
2518
2519
2520
2521

2522
2523
2524
2525
2526
2527
2528
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533







+







    Tcl_Interp *interp = rtPtr->interp;
    ForwardParam *paramPtr = evPtr->param;
    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected channels with handlers in
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    (void)mask;

    /*
     * Ignore the event if no one is waiting for its result anymore.
     */

    if (!resultPtr) {
	return 1;
2597
2598
2599
2600
2601
2602
2603
2604

2605
2606
2607
2608
2609
2610
2611
2602
2603
2604
2605
2606
2607
2608

2609
2610
2611
2612
2613
2614
2615
2616







-
+







				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		paramPtr->transform.buf = (char *)ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
2631
2632
2633
2634
2635
2636
2637
2638

2639
2640
2641
2642
2643
2644
2645
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645
2646
2647
2648
2649
2650







-
+







				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		paramPtr->transform.buf = (char *)ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673
2674
2665
2666
2667
2668
2669
2670
2671

2672
2673
2674
2675
2676
2677
2678
2679







-
+







	    unsigned char *bytev; /* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		paramPtr->transform.buf = (char *)ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

2687
2688
2689
2690
2691
2692
2693
2694

2695
2696
2697
2698
2699
2700
2701
2692
2693
2694
2695
2696
2697
2698

2699
2700
2701
2702
2703
2704
2705
2706







-
+







				/* Array of returned bytes */

	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = ckalloc(bytec);
		paramPtr->transform.buf = (char *)ckalloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

2747
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760
2761
2752
2753
2754
2755
2756
2757
2758

2759
2760
2761
2762
2763
2764
2765
2766







-
+







    return 1;
}

static void
SrcExitProc(
    ClientData clientData)
{
    ForwardingEvent *evPtr = clientData;
    ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
    ForwardingResult *resultPtr;
    ForwardParam *paramPtr;

    /*
     * NOTE (2): Can this handler be called with the originator blocked?
     */

2887
2888
2889
2890
2891
2892
2893
2894

2895
2896
2897
2898
2899
2900
2901
2892
2893
2894
2895
2896
2897
2898

2899
2900
2901
2902
2903
2904
2905
2906







-
+







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

static void
TimerRun(
    ClientData clientData)
{
    ReflectedTransform *rtPtr = clientData;
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    rtPtr->timer = NULL;
    Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
}

/*
 *----------------------------------------------------------------------

Changes to generic/tclIOUtil.c.

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
78
79
80
81
82
83
84

85
86
87
88
89
90
91







-







static void		FsRecacheFilesystemList(void);
static void		Claim(void);
static void		Disclaim(void);

static void *		DivertFindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		DivertUnloadFile(Tcl_LoadHandle loadHandle);


/*
 * Functions that provide native filesystem support. They are private and
 * should be used only here.  They should be called instead of calling Tclp...
 * native filesystem functions.  Others should use the Tcl_FS... functions
 * which ensure correct and complete virtual filesystem support.
 */
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426







-
+







 * The basic filesystem implementation.
 */

static void
FsThrExitProc(
    ClientData cd)
{
    ThreadSpecificData *tsdPtr = cd;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)cd;
    FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;

    /*
     * Discard the cwd copy.
     */

    if (tsdPtr->cwdPathPtr != NULL) {
575
576
577
578
579
580
581
582

583
584
585
586
587
588
589
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588







-
+







    /*
     * Refill the cache, honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = ckalloc(sizeof(FilesystemRecord));
	tmpFsRecPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = list;
	tmpFsRecPtr->prevPtr = NULL;
	list = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }
    tsdPtr->filesystemList = list;
849
850
851
852
853
854
855
856

857
858
859
860
861
862
863
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862







-
+







{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = ckalloc(sizeof(FilesystemRecord));
    newFilesystemPtr = (FilesystemRecord *)ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    Tcl_MutexLock(&filesystemMutex);

    newFilesystemPtr->nextPtr = filesystemList;
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938



1939
1940
1941
1942
1943
1944
1945
1928
1929
1930
1931
1932
1933
1934



1935
1936
1937
1938
1939
1940
1941
1942
1943
1944







-
-
-
+
+
+







static int
EvalFileCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldScriptFile = data[0];
    Tcl_Obj *pathPtr = data[1];
    Tcl_Obj *objPtr = data[2];
    Tcl_Obj *oldScriptFile = (Tcl_Obj *)data[0];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[2];

    /*
     * Restore the original iPtr->scriptFile value, but because the value may
     * have hanged during evaluation, don't assume it currently points to
     * pathPtr.
     */

2314
2315
2316
2317
2318
2319
2320


2321
2322
2323
2324
2325
2326
2327
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328







+
+







 */

static const char *const *
NativeFileAttrStrings(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    (void)pathPtr;
    (void)objPtrRef;
    return tclpFileAttrStrings;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsGet --
3022
3023
3024
3025
3026
3027
3028

3029
3030
3031
3032
3033
3034
3035
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037







+







    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* A place to store a pointer to the function
				 * that unloads the object. */
{
    const char *symbols[3];
    void *procPtrs[2];
    int res;
    (void)unloadProcPtr;

    symbols[0] = sym1;
    symbols[1] = sym2;
    symbols[2] = NULL;

    res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
    if (res == TCL_OK) {
3097
3098
3099
3100
3101
3102
3103

3104
3105
3106
3107
3108
3109
3110
3111
3112



3113
3114
3115
3116
3117
3118
3119
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114

3115
3116
3117
3118
3119
3120
3121
3122
3123
3124







+








-
+
+
+







     *
     * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available).
     *
     */


#ifdef hpux
    (void)shlibFile;
    return 1;
#else
    char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");

    if (skipstr && (skipstr[0] != '\0')) {
	return atoi(skipstr);
    }

#ifdef TCL_TEMPLOAD_NO_UNLINK
#ifndef TCL_TEMPLOAD_NO_UNLINK
    (void)shlibFile;
#else
/* At built time TCL_TEMPLOAD_NO_UNLINK can be set manually to control whether
 * this automatic overriding of unlink is included.
 */
#ifndef NO_FSTATFS
    {
	struct statfs fs;
	/*
3241
3242
3243
3244
3245
3246
3247
3248

3249
3250
3251
3252
3253
3254
3255
3246
3247
3248
3249
3250
3251
3252

3253
3254
3255
3256
3257
3258
3259
3260







-
+







	    goto mustCopyToTempAnyway;
	}
	buffer = TclpLoadMemoryGetBuffer(interp, size);
	if (!buffer) {
	    Tcl_Close(interp, data);
	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, buffer, size);
	ret = Tcl_Read(data, (char *)buffer, size);
	Tcl_Close(interp, data);
	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
		&unloadProcPtr, flags);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    goto resolveSymbols;
	}
    }
3356
3357
3358
3359
3360
3361
3362
3363

3364
3365
3366
3367
3368
3369
3370
3361
3362
3363
3364
3365
3366
3367

3368
3369
3370
3371
3372
3373
3374
3375







-
+







	return TCL_OK;
    }

    /*
     * Divert the unloading in order to unload and cleanup the temporary file.
     */

    tvdlPtr = ckalloc(sizeof(FsDivertLoad));
    tvdlPtr = (FsDivertLoad *)ckalloc(sizeof(FsDivertLoad));

    /*
     * Remember three pieces of information in order to clean up the diverted
     * load completely on platforms which allow proper unloading of code.
     */

    tvdlPtr->loadHandle = newLoadHandle;
3397
3398
3399
3400
3401
3402
3403
3404

3405
3406
3407
3408
3409
3410
3411
3402
3403
3404
3405
3406
3407
3408

3409
3410
3411
3412
3413
3414
3415
3416







-
+







	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    divertedLoadHandle = ckalloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);
4680
4681
4682
4683
4684
4685
4686

4687
4688
4689
4690
4691
4692
4693
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699







+







 */

static Tcl_Obj *
NativeFilesystemSeparator(
    Tcl_Obj *pathPtr)
{
    const char *separator = NULL; /* lint */
    (void)pathPtr;

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	separator = "/";
	break;
    case TCL_PLATFORM_WINDOWS:
	separator = "\\";

Changes to generic/tclIndexObj.c.

122
123
124
125
126
127
128
129

130
131
132
133
134
135
136
122
123
124
125
126
127
128

129
130
131
132
133
134
135
136







-
+







     * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
     * the common case where the result is cached).
     */

    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType);

    if (irPtr) {
	IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
	IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

	/*
	 * Here's hoping we don't get hit by unfortunate packing constraints
	 * on odd platforms like a Cray PVP...
	 */

	if (indexRep->tablePtr == (void *) tablePtr
196
197
198
199
200
201
202
203

204
205
206
207
208
209
210
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210







-
+







	return result;
    }

    /*
     * Build a string table from the list.
     */

    tablePtr = ckalloc((objc + 1) * sizeof(char *));
    tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	     * An exact match is always chosen, so we can stop here.
	     */

	    ckfree(tablePtr);
280
281
282
283
284
285
286
287

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

287
288
289
290
291
292
293
294







-
+







    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (irPtr) {
	indexRep = irPtr->twoPtrValue.ptr1;
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}
    }
    }

304
305
306
307
308
309
310
311

312
313
314
315
316
317
318
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318







-
+







    /*
     * Scan the table looking for one of:
     *  - An exact match (always preferred)
     *  - A single abbreviation (allowed depending on flags)
     *  - Several abbreviations (never allowed, but overridden by exact match)
     */

    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
    for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL;
	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
	    if (*p1 == '\0') {
		index = idx;
		goto done;
	    }
	}
344
345
346
347
348
349
350
351

352
353
354
355

356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376

377
378
379
380
381
382
383
344
345
346
347
348
349
350

351
352
353
354

355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
383







-
+



-
+




















-
+







     * new internal-rep if at all possible since that is potentially a slow
     * operation.
     */

    if (!(flags & INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (irPtr) {
	indexRep = irPtr->twoPtrValue.ptr1;
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
    } else {
	Tcl_ObjIntRep ir;

	indexRep = ckalloc(sizeof(IndexRep));
	indexRep = (IndexRep*)ckalloc(sizeof(IndexRep));
	ir.twoPtrValue.ptr1 = indexRep;
	Tcl_StoreIntRep(objPtr, &indexType, &ir);
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;
    }

    *indexPtr = index;
    return TCL_OK;

  error:
    if (interp != NULL) {
	/*
	 * Produce a fancy error message.
	 */

	int count = 0;

	TclNewObj(resultPtr);
	entryPtr = tablePtr;
	entryPtr = (const char* const *)tablePtr;
	while ((*entryPtr != NULL) && !**entryPtr) {
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	}
	Tcl_AppendStringsToObj(resultPtr,
		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
		msg, " \"", key, NULL);
	if (*entryPtr == NULL) {
424
425
426
427
428
429
430

431
432
433
434
435
436
437
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438







+







 */

static int
SetIndexFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
{
    (void)objPtr;
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "can't convert value to index except via Tcl_GetIndexFromObj API",
	    -1));
    }
    return TCL_ERROR;
}
453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468







-
+







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

static void
UpdateStringOfIndex(
    Tcl_Obj *objPtr)
{
    IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
    IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
    const char *indexStr = EXPAND_OF(indexRep);

    Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
}

/*
 *----------------------------------------------------------------------
483
484
485
486
487
488
489
490

491
492
493
494
495
496
497
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498







-
+








static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_ObjIntRep ir;
    IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
    IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep));

    memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
	    sizeof(IndexRep));

    ir.twoPtrValue.ptr1 = dupIndexRep;
    Tcl_StoreIntRep(dupPtr, &indexType, &ir);
}
570
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592

593
594
595
596
597
598
599
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601







-
+















+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixMatchObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags = 0, result, index;
    int dummyLength, i, errorLength;
    Tcl_Obj *errorPtr = NULL;
    const char *message = "option";
    Tcl_Obj *tablePtr, *objPtr, *resultPtr;
    static const char *const matchOptions[] = {
	"-error", "-exact", "-message", NULL
    };
    enum matchOptions {
	PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE
    };
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
	return TCL_ERROR;
    }

    for (i = 1; i < (objc - 2); i++) {
694
695
696
697
698
699
700
701

702
703
704
705
706
707
708

709
710
711
712
713
714
715
696
697
698
699
700
701
702

703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixAllObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int tableObjc, result, t, length, elemLength;
    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;
    (void)dummy;

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

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
751
752
753
754
755
756
757
758

759
760
761
762
763
764
765

766
767
768
769
770
771
772
754
755
756
757
758
759
760

761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixLongestObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int tableObjc, result, i, t, length, elemLength, resultLength;
    const char *string, *elemString, *resultString;
    Tcl_Obj **tableObjv;
    (void)dummy;

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

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
963
964
965
966
967
968
969
970

971
972
973
974
975
976
977
978
979
980
981

982
983
984
985
986
987
988
967
968
969
970
971
972
973

974
975
976
977
978
979
980
981
982
983
984

985
986
987
988
989
990
991
992







-
+










-
+







	for (i=0 ; i<toPrint ; i++) {
	    /*
	     * Add the element, quoting it if necessary.
	     */
	    const Tcl_ObjIntRep *irPtr;

	    if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
		IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp, len + 1);
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
1012
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
1016
1017
1018
1019
1020
1021
1022

1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1043







-
+












-
+







	 * If the object is an index type use the index table which allows for
	 * the correct error message even if the subcommand was abbreviated.
	 * Otherwise, just use the string rep.
	 */
	const Tcl_ObjIntRep *irPtr;

	if ((irPtr = TclFetchIntRep(objv[i], &indexType))) {
	    IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
	    IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;

	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp, len + 1);
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
1131
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148
1149







-
+







	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
	 */

	nrem = 1;
	leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers = (Tcl_Obj **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

    /*
1315
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1319
1320
1321
1322
1323
1324
1325

1326
1327
1328
1329
1330
1331
1332
1333







-
+








    if (objc > 0) {
	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
	nrem += objc;
    }
    leftovers[nrem] = NULL;
    *objcPtr = nrem++;
    *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
    *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *));
    return TCL_OK;

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

Changes to generic/tclInt.h.

4328
4329
4330
4331
4332
4333
4334
4335

4336
4337
4338
4339
4340
4341
4342
4328
4329
4330
4331
4332
4333
4334

4335
4336
4337
4338
4339
4340
4341
4342







-
+







	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			(cachePtr->numObjects == 0))) {			\
	    (objPtr) = TclThreadAllocObj();				\
	} else {							\
	    (objPtr) = cachePtr->firstObjPtr;				\
	    cachePtr->firstObjPtr = (objPtr)->internalRep.twoPtrValue.ptr1; \
	    cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \
	    --cachePtr->numObjects;					\
	}								\
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr)				\
    do {								\
	AllocCache *cachePtr;						\
4489
4490
4491
4492
4493
4494
4495















4496
4497
4498
4499
4500
4501
4502
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    if ((objPtr)->bytes != NULL) { \
	if ((objPtr)->bytes != &tclEmptyString) { \
	    ckfree((objPtr)->bytes); \
	} \
	(objPtr)->bytes = NULL; \
    }

/*
 * These form part of the native filesystem support. They are needed here
 * because we have a few native filesystem functions (which are the same for
 * win/unix) in this file.
 */

#ifdef __cplusplus
extern "C" {
#endif
MODULE_SCOPE const char *const		tclpFileAttrStrings[];
MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to test whether an object has a
 * string representation (or is a 'pure' internal value).
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
4519
4520
4521
4522
4523
4524
4525
4526

4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540

4541
4542
4543
4544
4545
4546
4547
4548







-
+







    do {								\
	Tcl_Obj *bignumObj = (objPtr);				\
	int bignumPayload =					\
		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
	if (bignumPayload == -1) {					\
	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
	} else {							\
	    (bignum).dp = bignumObj->internalRep.twoPtrValue.ptr1;	\
	    (bignum).dp = (mp_digit *)bignumObj->internalRep.twoPtrValue.ptr1;	\
	    (bignum).sign = bignumPayload >> 30;			\
	    (bignum).alloc = (bignumPayload >> 15) & 0x7fff;		\
	    (bignum).used = bignumPayload & 0x7fff;			\
	}								\
    } while (0)

/*
4967
4968
4969
4970
4971
4972
4973
4974

4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989

4990
4991
4992
4993
4994
4995
4996
4982
4983
4984
4985
4986
4987
4988

4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003

5004
5005
5006
5007
5008
5009
5010
5011







-
+














-
+







#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), (_objPtr));			\
	memPtr = (ClientData) (_objPtr);					\
	*(void **)&memPtr = (void *) (_objPtr);					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *) (memPtr));		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(_objPtr);						\
	memPtr = (ClientData) _objPtr;					\
	*(void **)memPtr = (void *) _objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr;				\
	_objPtr->bytes = NULL;						\
	_objPtr->typePtr = NULL;					\

Changes to generic/tclInterp.c.

332
333
334
335
336
337
338
339

340
341
342
343
344
345
346
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346







-
+







} PkgName;

int
Tcl_Init(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    PkgName pkgName = {NULL, "Tcl"};
    PkgName **names = TclInitPkgFiles(interp);
    PkgName **names = (PkgName **)TclInitPkgFiles(interp);
    int result = TCL_ERROR;

    pkgName.nextPtr = *names;
    *names = &pkgName;
    if (tclPreInitScript != NULL) {
	if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
	    goto end;
481
482
483
484
485
486
487
488

489
490
491
492
493
494
495
481
482
483
484
485
486
487

488
489
490
491
492
493
494
495







-
+







TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Master *masterPtr;
    Slave *slavePtr;

    interpInfoPtr = ckalloc(sizeof(InterpInfo));
    interpInfoPtr = (InterpInfo *)ckalloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    masterPtr = &interpInfoPtr->master;
    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
    masterPtr->targetsPtr = NULL;

    slavePtr = &interpInfoPtr->slave;
1033
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047







-
+







	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
	resultPtr = Tcl_NewObj();
	hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
	    string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
	    string = (char *)Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    Tcl_NewStringObj(string, -1));
	}
	Tcl_SetObjResult(interp, resultPtr);
	return TCL_OK;
    }
    case OPT_TRANSFER:
1104
1105
1106
1107
1108
1109
1110
1111

1112
1113
1114
1115
1116
1117
1118
1104
1105
1106
1107
1108
1109
1110

1111
1112
1113
1114
1115
1116
1117
1118







-
+







	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "alias \"%s\" in path \"%s\" not found",
		    aliasName, Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    NULL);
	    return TCL_ERROR;
	}
	aliasPtr = Tcl_GetHashValue(hPtr);
	aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
	if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "target interpreter for alias \"%s\" in path \"%s\" is "
		    "not my descendant", aliasName, Tcl_GetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", NULL);
	    return TCL_ERROR;
1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1187
1188
1189
1190
1191
1192
1193

1194
1195
1196
1197
1198
1199
1200
1201







-
+







    const char *const *argv)	/* These are the additional args. */
{
    Tcl_Obj *slaveObjPtr, *targetObjPtr;
    Tcl_Obj **objv;
    int i;
    int result;

    objv = TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc);
    objv = (Tcl_Obj **)TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc);
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], -1);
	Tcl_IncrRefCount(objv[i]);
    }

    slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
    Tcl_IncrRefCount(slaveObjPtr);
1293
1294
1295
1296
1297
1298
1299
1300

1301
1302
1303
1304
1305
1306
1307
1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1307







-
+







    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", aliasName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
	return TCL_ERROR;
    }
    aliasPtr = Tcl_GetHashValue(hPtr);
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;

    if (targetInterpPtr != NULL) {
	*targetInterpPtr = aliasPtr->targetInterp;
    }
    if (targetNamePtr != NULL) {
1355
1356
1357
1358
1359
1360
1361
1362

1363
1364
1365
1366
1367
1368
1369
1355
1356
1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367
1368
1369







-
+







    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", aliasName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
	return TCL_ERROR;
    }
    aliasPtr = Tcl_GetHashValue(hPtr);
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;

    if (targetInterpPtr != NULL) {
	*targetInterpPtr = aliasPtr->targetInterp;
    }
    if (targetNamePtr != NULL) {
1424
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437
1438
1424
1425
1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1438







-
+








    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases. If
     * we encounter the alias we are defining (or renaming to) any in the
     * chain then we have a loop.
     */

    aliasPtr = cmdPtr->objClientData;
    aliasPtr = (Alias *)cmdPtr->objClientData;
    nextAliasPtr = aliasPtr;
    while (1) {
	Tcl_Obj *cmdNamePtr;

	/*
	 * If the target of the next alias in the chain is the same as the
	 * source alias, we have a loop.
1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484
1485
1486
1487
1473
1474
1475
1476
1477
1478
1479

1480
1481
1482
1483
1484
1485
1486
1487







-
+







	 * Otherwise we do not have a loop.
	 */

	if (aliasCmdPtr->objProc != TclAliasObjCmd
		&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
	    return TCL_OK;
	}
	nextAliasPtr = aliasCmdPtr->objClientData;
	nextAliasPtr = (Alias *)aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}

/*
 *----------------------------------------------------------------------
1516
1517
1518
1519
1520
1521
1522
1523

1524
1525
1526
1527
1528
1529
1530
1516
1517
1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1530







-
+







    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Slave *slavePtr;
    Master *masterPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr = (Alias *)ckalloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;

1624
1625
1626
1627
1628
1629
1630
1631

1632
1633
1634
1635
1636
1637
1638
1624
1625
1626
1627
1628
1629
1630

1631
1632
1633
1634
1635
1636
1637
1638







-
+







     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = ckalloc(sizeof(Target));
    targetPtr = (Target *)ckalloc(sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    masterPtr = &((InterpInfo*) ((Interp*) masterInterp)->interpInfo)->master;
    targetPtr->nextPtr = masterPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (masterPtr->targetsPtr != NULL) {
1685
1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696
1697
1698
1699
1685
1686
1687
1688
1689
1690
1691

1692
1693
1694
1695
1696
1697
1698
1699







-
+







    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", TclGetString(namePtr)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
		TclGetString(namePtr), NULL);
	return TCL_ERROR;
    }
    aliasPtr = Tcl_GetHashValue(hPtr);
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1730
1731
1732
1733
1734
1735
1736
1737

1738
1739
1740
1741
1742
1743
1744
1730
1731
1732
1733
1734
1735
1736

1737
1738
1739
1740
1741
1742
1743
1744







-
+







     */

    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
    if (hPtr == NULL) {
	return TCL_OK;
    }
    aliasPtr = Tcl_GetHashValue(hPtr);
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
    Tcl_SetObjResult(interp, prefixPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1767
1768
1769
1770
1771
1772
1773
1774

1775
1776
1777
1778
1779
1780
1781
1767
1768
1769
1770
1771
1772
1773

1774
1775
1776
1777
1778
1779
1780
1781







-
+







    Alias *aliasPtr;
    Slave *slavePtr;

    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

    entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
    for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
	aliasPtr = Tcl_GetHashValue(entryPtr);
	aliasPtr = (Alias *)Tcl_GetHashValue(entryPtr);
	Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
1808
1809
1810
1811
1812
1813
1814
1815

1816
1817
1818
1819
1820
1821
1822
1808
1809
1810
1811
1812
1813
1814

1815
1816
1817
1818
1819
1820
1821
1822







-
+







static int
AliasNRCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = clientData;
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *listPtr;
    List *listRep;
    int flags = TCL_EVAL_INVOKE;

    /*
1857
1858
1859
1860
1861
1862
1863
1864

1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890
1857
1858
1859
1860
1861
1862
1863

1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882

1883
1884
1885
1886
1887
1888
1889
1890







-
+


















-
+







TclAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
    Alias *aliasPtr = (Alias *)clientData;
    Tcl_Interp *targetInterp = aliasPtr->targetInterp;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *tPtr = (Interp *) targetInterp;
    int isRootEnsemble;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the target interp's global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
	cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    Tcl_ResetResult(targetInterp);

1948
1949
1950
1951
1952
1953
1954
1955

1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973

1974
1975
1976
1977
1978
1979
1980
1948
1949
1950
1951
1952
1953
1954

1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972

1973
1974
1975
1976
1977
1978
1979
1980







-
+

















-
+







TclLocalAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = clientData;
    Alias *aliasPtr = (Alias *)clientData;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *iPtr = (Interp *) interp;
    int isRootEnsemble;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
	cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
2029
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2029
2030
2031
2032
2033
2034
2035

2036
2037
2038
2039
2040
2041
2042
2043







-
+







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

static void
AliasObjCmdDeleteProc(
    ClientData clientData)	/* The alias record for this alias. */
{
    Alias *aliasPtr = clientData;
    Alias *aliasPtr = (Alias *)clientData;
    Target *targetPtr;
    int i;
    Tcl_Obj **objv;

    Tcl_DecrRefCount(aliasPtr->token);
    objv = &aliasPtr->objPtr;
    for (i = 0; i < aliasPtr->objc; i++) {
2205
2206
2207
2208
2209
2210
2211
2212

2213
2214
2215
2216
2217
2218
2219
2205
2206
2207
2208
2209
2210
2211

2212
2213
2214
2215
2216
2217
2218
2219







-
+








    flags &= (CANCELED | TCL_CANCEL_UNWIND);

    masterPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->master;

    hPtr = Tcl_FirstHashEntry(&masterPtr->slaveTable, &hashSearch);
    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
	slavePtr = Tcl_GetHashValue(hPtr);
	slavePtr = (Slave *)Tcl_GetHashValue(hPtr);
	iPtr = (Interp *) slavePtr->slaveInterp;

	if (iPtr == NULL) {
	    continue;
	}

	if (flags == 0) {
2270
2271
2272
2273
2274
2275
2276
2277

2278
2279
2280
2281
2282
2283
2284
2270
2271
2272
2273
2274
2275
2276

2277
2278
2279
2280
2281
2282
2283
2284







-
+







	return TCL_ERROR;
    }
    iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
    if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK){
	return TCL_ERROR;
    }
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(askingInterp),
	    Tcl_NewStringObj(Tcl_GetHashKey(&iiPtr->master.slaveTable,
	    Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->master.slaveTable,
		    iiPtr->slave.slaveEntryPtr), -1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2318
2319
2320
2321
2322
2323
2324
2325

2326
2327
2328
2329
2330
2331
2332
2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330
2331
2332







-
+







	masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
		TclGetString(objv[i]));
	if (hPtr == NULL) {
	    searchInterp = NULL;
	    break;
	}
	slavePtr = Tcl_GetHashValue(hPtr);
	slavePtr = (Slave *)Tcl_GetHashValue(hPtr);
	searchInterp = slavePtr->slaveInterp;
	if (searchInterp == NULL) {
	    break;
	}
    }
    if (searchInterp == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2544
2545
2546
2547
2548
2549
2550
2551

2552
2553
2554
2555
2556
2557
2558
2544
2545
2546
2547
2548
2549
2550

2551
2552
2553
2554
2555
2556
2557
2558







-
+







static int
NRSlaveCmd(
    ClientData clientData,	/* Slave interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *slaveInterp = clientData;
    Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData;
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
	"eval",		"expose",	"hide",		"hidden",
	"issafe",	"invokehidden",	"limit",	"marktrusted",
	"recursionlimit", NULL
    };
2748
2749
2750
2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760
2761
2762







-
+







 */

static void
SlaveObjCmdDeleteProc(
    ClientData clientData)	/* The SlaveRecord for the command. */
{
    Slave *slavePtr;		/* Interim storage for Slave record. */
    Tcl_Interp *slaveInterp = clientData;
    Tcl_Interp *slaveInterp = (Tcl_Interp *)clientData;
				/* And for a slave interp. */

    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

    /*
     * Unlink the slave from its master interpreter.
     */
3088
3089
3090
3091
3092
3093
3094
3095

3096
3097
3098
3099
3100
3101
3102
3088
3089
3090
3091
3092
3093
3094

3095
3096
3097
3098
3099
3100
3101
3102







-
+








    hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
		hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    Tcl_ListObjAppendElement(NULL, listObjPtr,
		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
		    Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), -1));
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
3604
3605
3606
3607
3608
3609
3610
3611

3612
3613
3614
3615
3616
3617
3618
3604
3605
3606
3607
3608
3609
3610

3611
3612
3613
3614
3615
3616
3617
3618







-
+







	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = ckalloc(sizeof(LimitHandler));
    handlerPtr = (LimitHandler *)ckalloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*
4061
4062
4063
4064
4065
4066
4067
4068
4069


4070
4071
4072
4073
4074
4075
4076
4061
4062
4063
4064
4065
4066
4067


4068
4069
4070
4071
4072
4073
4074
4075
4076







-
-
+
+







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

static void
TimeLimitCallback(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;
    Interp *iPtr = clientData;
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Interp *iPtr = (Interp *)clientData;
    int code;

    Tcl_Preserve(interp);
    iPtr->limit.timeEvent = NULL;

    /*
     * Must reset the granularity ticker here to force an immediate full
4205
4206
4207
4208
4209
4210
4211
4212

4213
4214
4215
4216
4217
4218
4219
4205
4206
4207
4208
4209
4210
4211

4212
4213
4214
4215
4216
4217
4218
4219







-
+







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

static void
DeleteScriptLimitCallback(
    ClientData clientData)
{
    ScriptLimitCallback *limitCBPtr = clientData;
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    ckfree(limitCBPtr);
}
4237
4238
4239
4240
4241
4242
4243
4244

4245
4246
4247
4248
4249
4250
4251
4237
4238
4239
4240
4241
4242
4243

4244
4245
4246
4247
4248
4249
4250
4251







-
+







 */

static void
CallScriptLimitCallback(
    ClientData clientData,
    Tcl_Interp *dummy)		/* Interpreter which failed the limit */
{
    ScriptLimitCallback *limitCBPtr = clientData;
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    int code;
    (void)dummy;

    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;
    }
    Tcl_Preserve(limitCBPtr->interp);
4306
4307
4308
4309
4310
4311
4312
4313

4314
4315
4316
4317
4318
4319

4320
4321
4322
4323
4324
4325
4326
4306
4307
4308
4309
4310
4311
4312

4313
4314
4315
4316
4317
4318

4319
4320
4321
4322
4323
4324
4325
4326







-
+





-
+







	}
	return;
    }

    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key,
	    &isNew);
    if (!isNew) {
	limitCBPtr = Tcl_GetHashValue(hashPtr);
	limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    limitCBPtr = ckalloc(sizeof(ScriptLimitCallback));
    limitCBPtr = (ScriptLimitCallback *)ckalloc(sizeof(ScriptLimitCallback));
    limitCBPtr->interp = interp;
    limitCBPtr->scriptObj = scriptObj;
    limitCBPtr->entryPtr = hashPtr;
    limitCBPtr->type = type;
    Tcl_IncrRefCount(scriptObj);

    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,
4501
4502
4503
4504
4505
4506
4507
4508

4509
4510
4511
4512
4513
4514
4515
4501
4502
4503
4504
4505
4506
4507

4508
4509
4510
4511
4512
4513
4514
4515







-
+







	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = slaveInterp;
	key.type = TCL_LIMIT_COMMANDS;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	if (hPtr != NULL) {
	    limitCBPtr = Tcl_GetHashValue(hPtr);
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
4543
4544
4545
4546
4547
4548
4549
4550

4551
4552
4553
4554
4555
4556
4557
4543
4544
4545
4546
4547
4548
4549

4550
4551
4552
4553
4554
4555
4556
4557







-
+







	}
	switch ((enum Options) index) {
	case OPT_CMD:
	    key.interp = slaveInterp;
	    key.type = TCL_LIMIT_COMMANDS;
	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	    if (hPtr != NULL) {
		limitCBPtr = Tcl_GetHashValue(hPtr);
		limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
		}
	    }
	    break;
	case OPT_GRAN:
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
4689
4690
4691
4692
4693
4694
4695
4696

4697
4698
4699
4700
4701
4702
4703
4689
4690
4691
4692
4693
4694
4695

4696
4697
4698
4699
4700
4701
4702
4703







-
+







	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = slaveInterp;
	key.type = TCL_LIMIT_TIME;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	if (hPtr != NULL) {
	    limitCBPtr = Tcl_GetHashValue(hPtr);
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
4737
4738
4739
4740
4741
4742
4743
4744

4745
4746
4747
4748
4749
4750
4751
4737
4738
4739
4740
4741
4742
4743

4744
4745
4746
4747
4748
4749
4750
4751







-
+







	}
	switch ((enum Options) index) {
	case OPT_CMD:
	    key.interp = slaveInterp;
	    key.type = TCL_LIMIT_TIME;
	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	    if (hPtr != NULL) {
		limitCBPtr = Tcl_GetHashValue(hPtr);
		limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
		}
	    }
	    break;
	case OPT_GRAN:
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(

Changes to generic/tclLink.c.

167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181







-
+







	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr = (Link *)ckalloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->nsPtr = NULL;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
255
256
257
258
259
260
261
262

263
264
265
266
267
268
269
255
256
257
258
259
260
261

262
263
264
265
266
267
268
269







-
+








    if (size < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong array size given", -1));
	return TCL_ERROR;
    }

    linkPtr = ckalloc(sizeof(Link));
    linkPtr = (Link *)ckalloc(sizeof(Link));
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
	linkPtr->type = TCL_LINK_LONG;
    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
	linkPtr->type = TCL_LINK_ULONG;
531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
531
532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+







    int type, intValue;

    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
	if (type == TCL_NUMBER_INT) {
	    *widePtr = *((const Tcl_WideInt *) clientData);
	    return (*widePtr < 0);
	} else if (type == TCL_NUMBER_BIG) {
	    mp_int *numPtr = clientData;
	    mp_int *numPtr = (mp_int *)clientData;
	    Tcl_WideUInt value = 0;
	    union {
		Tcl_WideUInt value;
		unsigned char bytes[sizeof(Tcl_WideUInt)];
	    } scratch;
	    size_t numBytes;
	    unsigned char *bytes = scratch.bytes;
624
625
626
627
628
629
630
631

632
633
634
635

636
637
638
639
640
641
642
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
639
640
641
642
643







-
+




+








/*
 * Mark an object as holding a weird double.
 */

static int
SetInvalidRealFromAny(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    Tcl_Obj *objPtr)
{
    const char *str;
    const char *endPtr;
    (void)dummy;

    str = TclGetString(objPtr);
    if ((objPtr->length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
745
746
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
746
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







-
+












+
+







LinkTraceProc(
    ClientData clientData,	/* Contains information about the link. */
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    const char *name1,		/* First part of variable name. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = clientData;
    Link *linkPtr = (Link *)clientData;
    int changed;
    int valueLength;
    const char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    int objc;
    Tcl_Obj **objv;
    int i;
    (void)name1;
    (void)name2;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
893
894
895
896
897
898
899
900

901
902
903
904
905
906
907
896
897
898
899
900
901
902

903
904
905
906
907
908
909
910







-
+








    switch (linkPtr->type) {
    case TCL_LINK_STRING:
	value = TclGetString(valueObj);
	valueLength = valueObj->length + 1;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	*pp = (char *)ckrealloc(*pp, valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
1287
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320

1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333

1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359

1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372

1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

1386
1387
1388
1389
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
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335

1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374

1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387

1388
1389
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







-
+












-
+












-
+












-
+












-
+












-
+












-
+












-
+












-
+













-
+












-
+













-
+












-
+







    Tcl_Obj *resultObj, **objv;
    int i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.iPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewIntObj(linkPtr->lastValue.i);
    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.wPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.cPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.ucPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.sPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewIntObj(linkPtr->lastValue.usPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.uiPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ui = LinkedVar(unsigned int);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.lPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.l = LinkedVar(long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj(linkPtr->lastValue.ulPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ul = LinkedVar(unsigned long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    objv = (Tcl_Obj **)ckalloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewWideIntObj((Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    ckfree(objv);
	    return resultObj;

Changes to generic/tclListObj.c.

58
59
60
61
62
63
64
65

66
67
68
69
70
71
72
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72







-
+







	Tcl_StoreIntRep((objPtr), &tclListType, &ir);			\
    } while (0)

#define ListGetIntRep(objPtr, listRepPtr)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclListType);		\
	(listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

#define ListResetIntRep(objPtr, listRepPtr) \
    TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)

#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
118
119
120
121
122
123
124
125

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

125
126
127
128
129
130
131
132







-
+







	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = attemptckalloc(LIST_SIZE(objc));
    listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    LIST_SIZE(objc));
	}
	return NULL;
    }
337
338
339
340
341
342
343


344
345
346
347
348
349
350
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352







+
+







    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;
    return Tcl_NewListObj(objc, objv);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
714
715
716
717
718
719
720
721

722
723
724
725
726
727
728

729
730
731
732

733
734
735
736
737
738
739
716
717
718
719
720
721
722

723
724
725
726
727
728
729

730
731
732
733

734
735
736
737
738
739
740
741







-
+






-
+



-
+







    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */

	attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }
1043
1044
1045
1046
1047
1048
1049
1050

1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1045
1046
1047
1048
1049
1050
1051

1052
1053
1054
1055
1056
1057
1058

1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1070







-
+






-
+



-
+







    }

    if (needGrow && !isShared) {
	/* Try to use realloc */
	List *newPtr = NULL;
	int attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	    newPtr = (List *)attemptckrealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    ListResetIntRep(listPtr, listRepPtr);
	    elemPtrs = &listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = numRequired > listRepPtr->maxElemCount;
1685
1686
1687
1688
1689
1690
1691
1692
1693


1694
1695
1696
1697
1698
1699
1700
1687
1688
1689
1690
1691
1692
1693


1694
1695
1696
1697
1698
1699
1700
1701
1702







-
-
+
+







	List *listRepPtr;

	/*
	 * Clear away our intrep surgery mess.
	 */

	irPtr = TclFetchIntRep(objPtr, &tclListType);
	listRepPtr = irPtr->twoPtrValue.ptr1;
	chainPtr = irPtr->twoPtrValue.ptr2;
	listRepPtr = (List *)irPtr->twoPtrValue.ptr1;
	chainPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps of all
	     * containing lists.
	     */
2167
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179
2180
2181
2169
2170
2171
2172
2173
2174
2175

2176
2177
2178
2179
2180
2181
2182
2183







-
+







    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	 */

	flagPtr = ckalloc(numElems);
	flagPtr = (char *)ckalloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {

Changes to generic/tclLiteral.c.

110
111
112
113
114
115
116


117
118
119
120
121
122
123
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125







+
+







     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable((Interp *) interp);
#else
    (void)interp;
#endif /*TCL_COMPILE_DEBUG*/

    /*
     * We used to call TclReleaseLiteral for each literal in the table, which
     * is rather inefficient as it causes one lookup-by-hash for each
     * reference to the literal. We now rely at interp-deletion on each
     * bytecode object to release its references to the literal Tcl_Obj
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288







-
+







#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;
397
398
399
400
401
402
403
404

405
406
407
408
409
410
411
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413







-
+







				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = ePtr;
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    unsigned int localHash;
    int objIndex, isNew;
754
755
756
757
758
759
760
761

762
763
764
765
766
767
768

769
770
771
772
773
774
775
756
757
758
759
760
761
762

763
764
765
766
767
768
769

770
771
772
773
774
775
776
777







-
+






-
+








    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = ckrealloc(currArrayPtr, newSize);
	newArrayPtr = (LiteralEntry *)ckrealloc(currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	newArrayPtr = ckalloc(newSize);
	newArrayPtr = (LiteralEntry *)ckalloc(newSize);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;
    }

    /*
     * Update the local literal table's bucket array.
     */
988
989
990
991
992
993
994
995

996
997
998
999
1000
1001
1002
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1004







-
+







	 * with what we have.
	 */

	return;
    }

    tablePtr->numBuckets *= 4;
    tablePtr->buckets = ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
    tablePtr->buckets = (LiteralEntry **)ckalloc(tablePtr->numBuckets * sizeof(LiteralEntry*));
    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
	    count>0 ; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->mask = (tablePtr->mask << 2) + 3;

1126
1127
1128
1129
1130
1131
1132
1133

1134
1135
1136
1137
1138
1139
1140
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137
1138
1139
1140
1141
1142







-
+







	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = ckalloc(NUM_COUNTERS*60 + 300);
    result = (char *)ckalloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
		i, count[i]);
	p += strlen(p);

Changes to generic/tclLoad.c.

136
137
138
139
140
141
142

143
144
145
146
147
148
149
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150







+







    Tcl_Obj *const *savedobjv = objv;
    static const char *const options[] = {
	"-global",		"-lazy",		"--",	NULL
    };
    enum options {
	LOAD_GLOBAL,	LOAD_LAZY,	LOAD_LAST
    };
    (void)dummy;

    while (objc > 2) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
		&index) != TCL_OK) {
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
268
269
270
271
272
273
274

275
276
277
278
279
280
281
282







-
+







    /*
     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then
     * there's nothing for us to do.
     */

    if (pkgPtr != NULL) {
	ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		goto done;
	    }
	}
    }
397
398
399
400
401
402
403
404

405
406

407
408
409

410
411
412
413
414
415
416
398
399
400
401
402
403
404

405
406

407
408
409

410
411
412
413
414
415
416
417







-
+

-
+


-
+







	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = ckalloc(sizeof(LoadedPackage));
	pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = ckalloc(len);
	pkgPtr->fileName	   = (char *)ckalloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = ckalloc(len);
	pkgPtr->packageName	   = (char *)ckalloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
503
504
505
506
507
508
509
510
511


512
513
514
515
516
517
518
504
505
506
507
508
509
510


511
512
513
514
515
516
517
518
519







-
-
+
+







    Tcl_MutexUnlock(&packageMutex);

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */

    ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = ckalloc(sizeof(InterpPackage));
    ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
558
559
560
561
562
563
564

565
566
567
568
569
570
571
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573







+







    const char *packageName;
    static const char *const options[] = {
	"-nocomplain", "-keeplibrary", "--", NULL
    };
    enum options {
	UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
    };
    (void)dummy;

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&index) != TCL_OK) {
	    fullFileName = Tcl_GetString(objv[i]);
	    if (fullFileName[0] == '-') {
		/*
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
718
719
720
721
722
723
724

725
726
727
728
729
730
731
732







-
+







     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then we
     * should proceed with unloading.
     */

    code = TCL_ERROR;
    if (pkgPtr != NULL) {
	ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		break;
	    }
	}
    }
871
872
873
874
875
876
877
878

879
880
881
882
883
884
885
873
874
875
876
877
878
879

880
881
882
883
884
885
886
887







-
+







		    }
		}

		/*
		 * Remove this library from the interpreter's library cache.
		 */

		ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
		ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
		ipPtr = ipFirstPtr;
		if (ipPtr->pkgPtr == defaultPtr) {
		    ipFirstPtr = ipFirstPtr->nextPtr;
		} else {
		    InterpPackage *ipPrevPtr;

		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
978
979
980
981
982
983
984
985
986


987
988

989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021
1022
1023
1024
1025
980
981
982
983
984
985
986


987
988
989

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007

1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1027







-
-
+
+

-
+

















-
+











-
+








    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= ckalloc(1);
	pkgPtr = (LoadedPackage *)ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *)ckalloc(1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= ckalloc(strlen(pkgName) + 1);
	pkgPtr->packageName	= (char *)ckalloc(strlen(pkgName) + 1);
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
	Tcl_MutexUnlock(&packageMutex);
    }

    if (interp != NULL) {

	/*
	 * If we're loading the package into an interpreter, determine whether
	 * it's already loaded.
	 */

	ipFirstPtr = Tcl_GetAssocData(interp, "tclLoad", NULL);
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		return;
	    }
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = ckalloc(sizeof(InterpPackage));
	ipPtr = (InterpPackage *)ckalloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
    }
}

/*
1087
1088
1089
1090
1091
1092
1093
1094

1095
1096
1097
1098
1099
1100
1101
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103







-
+







	return TCL_OK;
    }

    target = Tcl_GetSlave(interp, targetName);
    if (target == NULL) {
	return TCL_ERROR;
    }
    ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);

    /*
     * Return information about all of the available packages.
     */
    if (packageName) {
	resultObj = NULL;

1148
1149
1150
1151
1152
1153
1154
1155

1156
1157

1158
1159

1160
1161
1162
1163
1164
1165
1166
1150
1151
1152
1153
1154
1155
1156

1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169







-
+


+

-
+







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

static void
LoadCleanupProc(
    ClientData clientData,	/* Pointer to first InterpPackage structure
				 * for interp. */
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
    Tcl_Interp *dummy)		/* Interpreter that is being deleted. */
{
    InterpPackage *ipPtr, *nextPtr;
    (void)dummy;

    ipPtr = clientData;
    ipPtr = (InterpPackage *)clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	ckfree(ipPtr);
	ipPtr = nextPtr;
    }
}


Changes to generic/tclMain.c.

734
735
736
737
738
739
740
741

742
743
744

745
746
747
748
749
750
751
734
735
736
737
738
739
740

741
742
743
744
745
746
747
748
749
750
751
752







-
+



+







    /* ARGSUSED */
static void
StdinProc(
    ClientData clientData,	/* The state of interactive cmd line */
    int mask)			/* Not used. */
{
    int code, length;
    InteractiveState *isPtr = clientData;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;
    (void)mask;

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    length = Tcl_GetsObj(chan, commandPtr);
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
907
908
909
910
911
912
913

914
915
916
917
918
919
920
921







-
+







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

static void
FreeMainInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;
    Tcl_Interp *interp = (Tcl_Interp *)clientData;

    /*if (TclInExit()) return;*/

    if (!Tcl_InterpDeleted(interp)) {
	Tcl_DeleteInterp(interp);
    }
    Tcl_SetStartupScript(NULL, NULL);

Changes to generic/tclNamesp.c.

162
163
164
165
166
167
168
169

170
171
172
173
174
175
176
162
163
164
165
166
167
168

169
170
171
172
173
174
175
176







-
+







	Tcl_StoreIntRep((objPtr), &nsNameType, &ir);			\
    } while (0)

#define NsNameGetIntRep(objPtr, nnPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &nsNameType);			\
	(nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

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

476
477
478
479
480
481
482
483

484
485
486
487
488
489
490
476
477
478
479
480
481
482

483
484
485
486
487
488
489
490







-
+







				 * If new variables are created, they will be
				 * created in the frame. If 0, the frame is
				 * for a "namespace eval" or "namespace
				 * inscope" command and var references are
				 * treated as references to namespace
				 * variables. */
{
    *framePtrPtr = TclStackAlloc(interp, sizeof(CallFrame));
    *framePtrPtr = (Tcl_CallFrame *)TclStackAlloc(interp, sizeof(CallFrame));
    return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
	    isProcCallFrame);
}

void
TclPopStackFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
510
511
512
513
514
515
516
517

518
519
520
521
522




523
524
525
526
527
528
529
510
511
512
513
514
515
516

517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533







-
+





+
+
+
+







 *	Read and unset traces are established on ::errorCode.
 *
 *----------------------------------------------------------------------
 */

static char *
EstablishErrorCodeTraces(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    (void)dummy;
    (void)name1;
    (void)name2;
    (void)flags;
    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
	    ErrorCodeRead, NULL);
    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
	    EstablishErrorCodeTraces, NULL);
    return NULL;
}

542
543
544
545
546
547
548
549

550
551
552
553
554
555




556
557
558
559
560
561
562
546
547
548
549
550
551
552

553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570







-
+






+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ErrorCodeRead(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;
    (void)name1;
    (void)name2;
    (void)flags;

    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
	return NULL;
    }
    if (iPtr->errorCode) {
	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		iPtr->errorCode, TCL_GLOBAL_ONLY);
584
585
586
587
588
589
590
591

592
593
594
595
596





597
598
599
600
601
602
603
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616







-
+





+
+
+
+
+







 *	Read and unset traces are established on ::errorInfo.
 *
 *----------------------------------------------------------------------
 */

static char *
EstablishErrorInfoTraces(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    (void)dummy;
    (void)name1;
    (void)name2;
    (void)flags;

    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
	    ErrorInfoRead, NULL);
    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
	    EstablishErrorInfoTraces, NULL);
    return NULL;
}

616
617
618
619
620
621
622
623

624
625
626
627
628
629




630
631
632
633
634
635
636
629
630
631
632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653







-
+






+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ErrorInfoRead(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    const char *name1,
    const char *name2,
    int flags)
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;
    (void)name1;
    (void)name2;
    (void)flags;

    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
	return NULL;
    }
    if (iPtr->errorInfo) {
	Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
		iPtr->errorInfo, TCL_GLOBAL_ONLY);
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







-
+

-
+








    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = ckalloc(sizeof(Namespace));
    nsPtr = (Namespace *)ckalloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = ckalloc(nameLen);
    nsPtr->name = (char *)ckalloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
871
872
873
874
875
876
877
878

879
880
881
882
883
884
885
888
889
890
891
892
893
894

895
896
897
898
899
900
901
902







-
+







	    namePtr = buffPtr;
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = ckalloc(nameLen + 1);
    nsPtr->fullName = (char *)ckalloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
963
964
965
966
967
968
969
970

971
972
973
974
975
976
977
980
981
982
983
984
985
986

987
988
989
990
991
992
993
994







-
+







     *
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = Tcl_GetHashValue(entryPtr);
	cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == TclNRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156

1157
1158
1159
1160
1161
1162
1163
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172

1173
1174
1175
1176
1177
1178
1179
1180







-
+






-
+







     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	int length = nsPtr->cmdTable.numEntries;
	Command **cmds = TclStackAlloc((Tcl_Interp *) iPtr,
	Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    cmds[i] = Tcl_GetHashValue(entryPtr);
	    cmds[i] = (Command *)Tcl_GetHashValue(entryPtr);
	    cmds[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmds[i]);
	    TclCleanupCommandMacro(cmds[i]);
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
1241
1242

1243
1244
1245
1246
1247
1248
1249
1231
1232
1233
1234
1235
1236
1237

1238
1239
1240
1241
1242
1243
1244

1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258

1259
1260
1261
1262
1263
1264
1265
1266







-
+






-
+













-
+







     *
     * Important: leave the hash table itself still live.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	int length = nsPtr->childTable.numEntries;
	Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
	Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    children[i] = Tcl_GetHashValue(entryPtr);
	    children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
	    children[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
	    TclNsDecrRefCount(children[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, children);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	while (nsPtr->childTablePtr->numEntries > 0) {
	    int length = nsPtr->childTablePtr->numEntries;
	    Namespace **children = TclStackAlloc((Tcl_Interp *) iPtr,
	    Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		children[i] = Tcl_GetHashValue(entryPtr);
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470
1471

1472
1473
1474
1475
1476
1477
1478
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481
1482
1483
1484
1485
1486
1487

1488
1489
1490
1491
1492
1493
1494
1495







-
+








-
+







     * pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (neededElems > nsPtr->maxExportPatterns) {
	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
	nsPtr->exportArrayPtr = ckrealloc(nsPtr->exportArrayPtr,
	nsPtr->exportArrayPtr = (char **)ckrealloc(nsPtr->exportArrayPtr,
		sizeof(char *) * nsPtr->maxExportPatterns);
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = ckalloc(len + 1);
    patternCpy = (char *)ckalloc(len + 1);
    memcpy(patternCpy, pattern, len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
1675
1676
1677
1678
1679
1680
1681
1682

1683
1684
1685
1686
1687
1688
1689
1692
1693
1694
1695
1696
1697
1698

1699
1700
1701
1702
1703
1704
1705
1706







-
+







	    return TCL_OK;
	}
	return DoImport(interp, nsPtr, hPtr, simplePattern, pattern,
		importNsPtr, allowOverwrite);
    }
    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
	    (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
	char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
	char *cmdName = (char *)Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);

	if (Tcl_StringMatch(cmdName, simplePattern) &&
		DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr,
		allowOverwrite) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }
1762
1763
1764
1765
1766
1767
1768
1769

1770
1771

1772
1773
1774
1775

1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789

1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803

1804
1805
1806
1807
1808

1809
1810
1811

1812
1813
1814
1815
1816
1817
1818
1779
1780
1781
1782
1783
1784
1785

1786
1787

1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805

1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824

1825
1826
1827

1828
1829
1830
1831
1832
1833
1834
1835







-
+

-
+



-
+













-
+













-
+




-
+


-
+







	Tcl_DStringAppend(&ds, cmdName, -1);

	/*
	 * Check whether creating the new imported command in the current
	 * namespace would create a cycle of imported command references.
	 */

	cmdPtr = Tcl_GetHashValue(hPtr);
	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
	    Command *overwrite = Tcl_GetHashValue(found);
	    Command *overwrite = (Command *)Tcl_GetHashValue(found);
	    Command *linkCmd = cmdPtr;

	    while (linkCmd->deleteProc == DeleteImportedCmd) {
		dataPtr = linkCmd->objClientData;
		dataPtr = (ImportedCmdData *)linkCmd->objClientData;
		linkCmd = dataPtr->realCmdPtr;
		if (overwrite == linkCmd) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "import pattern \"%s\" would create a loop"
                            " containing command \"%s\"",
                            pattern, Tcl_DStringValue(&ds)));
		    Tcl_DStringFree(&ds);
		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = ckalloc(sizeof(ImportedCmdData));
	dataPtr = (ImportedCmdData *)ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
	 * Create an ImportRef structure describing this new import command
	 * and add it to the import ref list in the "real" command.
	 */

	refPtr = ckalloc(sizeof(ImportRef));
	refPtr = (ImportRef *)ckalloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = Tcl_GetHashValue(found);
	Command *overwrite = (Command *)Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {
	    ImportedCmdData *dataPtr = overwrite->objClientData;
	    ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData;

	    if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
		/*
		 * Repeated import of same command is acceptable.
		 */

		return TCL_OK;
1898
1899
1900
1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
1913
1914
1915

1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935

1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948

1949
1950
1951
1952
1953
1954
1955
1915
1916
1917
1918
1919
1920
1921

1922
1923
1924
1925
1926
1927
1928
1929
1930
1931

1932
1933
1934
1935
1936

1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964

1965
1966
1967
1968
1969
1970
1971
1972







-
+









-
+




-
+














-
+












-
+







	/*
	 * The pattern is simple. Delete any imported commands that match it.
	 */

	if (TclMatchIsTrivial(simplePattern)) {
	    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	    if (hPtr != NULL) {
		Command *cmdPtr = Tcl_GetHashValue(hPtr);
		Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

		if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) {
		    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
		}
	    }
	    return TCL_OK;
	}
	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
	    Command *cmdPtr = Tcl_GetHashValue(hPtr);
	    Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	    if (cmdPtr->deleteProc != DeleteImportedCmd) {
		continue;
	    }
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
	    cmdName = (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
	    if (Tcl_StringMatch(cmdName, simplePattern)) {
		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
	    }
	}
	return TCL_OK;
    }

    /*
     * The pattern was namespace-qualified.
     */

    for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);
	    hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_CmdInfo info;
	Tcl_Command token = Tcl_GetHashValue(hPtr);
	Tcl_Command token = (Tcl_Command)Tcl_GetHashValue(hPtr);
	Tcl_Command origin = TclGetOriginalCommand(token);

	if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {
	    continue;			/* Not an imported command. */
	}
	if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
	    /*
	     * Original not in namespace we're matching. Check the first link
	     * in the import chain.
	     */

	    Command *cmdPtr = (Command *) token;
	    ImportedCmdData *dataPtr = cmdPtr->objClientData;
	    ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData;
	    Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;

	    if (firstToken == origin) {
		continue;
	    }
	    Tcl_GetCommandInfoFromToken(firstToken, &info);
	    if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
1996
1997
1998
1999
2000
2001
2002
2003

2004
2005
2006
2007
2008
2009
2010
2013
2014
2015
2016
2017
2018
2019

2020
2021
2022
2023
2024
2025
2026
2027







-
+







    ImportedCmdData *dataPtr;

    if (cmdPtr->deleteProc != DeleteImportedCmd) {
	return NULL;
    }

    while (cmdPtr->deleteProc == DeleteImportedCmd) {
	dataPtr = cmdPtr->objClientData;
	dataPtr = (ImportedCmdData *)cmdPtr->objClientData;
	cmdPtr = dataPtr->realCmdPtr;
    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
2029
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2046
2047
2048
2049
2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060







-
+







InvokeImportedNRCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    ImportedCmdData *dataPtr = clientData;
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

int
2074
2075
2076
2077
2078
2079
2080
2081

2082
2083
2084
2085
2086
2087
2088
2091
2092
2093
2094
2095
2096
2097

2098
2099
2100
2101
2102
2103
2104
2105







-
+







 */

static void
DeleteImportedCmd(
    ClientData clientData)	/* Points to the imported command's
				 * ImportedCmdData structure. */
{
    ImportedCmdData *dataPtr = clientData;
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    Command *selfPtr = dataPtr->selfPtr;
    ImportRef *refPtr, *prevPtr;

    prevPtr = NULL;
    for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
	    refPtr = refPtr->nextPtr) {
2350
2351
2352
2353
2354
2355
2356
2357

2358
2359
2360
2361
2362
2363
2364
2367
2368
2369
2370
2371
2372
2373

2374
2375
2376
2377
2378
2379
2380
2381







-
+







	    if (nsPtr->childTablePtr == NULL) {
		entryPtr = NULL;
	    } else {
		entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
	    }
#endif
	    if (entryPtr != NULL) {
		nsPtr = Tcl_GetHashValue(entryPtr);
		nsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
		Tcl_CallFrame *framePtr;

		(void) TclPushStackFrame(interp, &framePtr,
			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);

		nsPtr = (Namespace *)
2385
2386
2387
2388
2389
2390
2391
2392

2393
2394
2395
2396
2397
2398
2399
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
2416







-
+







	    if (altNsPtr->childTablePtr != NULL) {
		entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
	    } else {
		entryPtr = NULL;
	    }
#endif
	    if (entryPtr != NULL) {
		altNsPtr = Tcl_GetHashValue(entryPtr);
		altNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
	    } else {
		altNsPtr = NULL;
	    }
	}

	/*
	 * If both search paths have failed, return NULL results.
2635
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663

2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681

2682
2683
2684
2685
2686
2687
2688
2652
2653
2654
2655
2656
2657
2658

2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697

2698
2699
2700
2701
2702
2703
2704
2705







-
+




















-
+

















-
+







		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
		    || !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * Next, check along the path.
	 */

	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
	    if (pathNsPtr == NULL) {
		continue;
	    }
	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * If we've still not found the command, look in the global namespace
	 * as a last resort.
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {
	Namespace *nsPtr[2];
	int search;

2696
2697
2698
2699
2700
2701
2702
2703

2704
2705
2706
2707
2708
2709
2710
2713
2714
2715
2716
2717
2718
2719

2720
2721
2722
2723
2724
2725
2726
2727







-
+







	 */

	for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
	    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
		entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
			simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    }

    if (cmdPtr != NULL) {
	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787

2788
2789
2790
2791
2792
2793
2794
2777
2778
2779
2780
2781
2782
2783

2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803

2804
2805
2806
2807
2808
2809
2810
2811







-
+



















-
+







    Tcl_HashEntry *hPtr;
    Namespace *nsPtr;
    Namespace *trailNsPtr, *shadowNsPtr;
    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    int found, i;
    int trailFront = -1;
    int trailSize = 5;		/* Formerly NUM_TRAIL_ELEMS. */
    Namespace **trailPtr = TclStackAlloc(interp,
    Namespace **trailPtr = (Namespace **)TclStackAlloc(interp,
	    trailSize * sizeof(Namespace *));

    /*
     * Start at the namespace containing the new command, and work up through
     * the list of parents. Stop just before the global namespace, since the
     * global namespace can't "shadow" its own entries.
     *
     * The namespace "trail" list we build consists of the names of each
     * namespace that encloses the new command, in order from outermost to
     * innermost: for example, "a" then "b". Each iteration of this loop
     * eventually extends the trail upwards by one namespace, nsPtr. We use
     * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
     * now-invalid cached command references. This will happen if nsPtr
     * (e.g. "a") contains a sequence of child namespaces (e.g. "b") such that
     * there is a identically-named sequence of child namespaces starting from
     * :: (e.g. "::b") whose tail namespace contains a command also named
     * cmdName.
     */

    cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
    cmdName = (char *)Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
    for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ;
	    nsPtr=nsPtr->parentPtr) {
	/*
	 * Find the maximal sequence of child namespaces contained in nsPtr
	 * such that there is a identically-named sequence of child namespaces
	 * starting from ::. shadowNsPtr will be the tail of this sequence, or
	 * the deepest namespace under :: that might contain a command now
2809
2810
2811
2812
2813
2814
2815
2816

2817
2818
2819
2820
2821
2822
2823
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
2840







-
+







		hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
			trailNsPtr->name);
	    } else {
		hPtr = NULL;
	    }
#endif
	    if (hPtr != NULL) {
		shadowNsPtr = Tcl_GetHashValue(hPtr);
		shadowNsPtr = (Namespace *)Tcl_GetHashValue(hPtr);
	    } else {
		found = 0;
		break;
	    }
	}

	/*
2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2867
2868
2869
2870
2871
2872
2873

2874
2875
2876
2877
2878
2879
2880
2881







-
+







	 * the trailPtr array.
	 */

	trailFront++;
	if (trailFront == trailSize) {
	    int newSize = 2 * trailSize;

	    trailPtr = TclStackRealloc(interp, trailPtr,
	    trailPtr = (Namespace **)TclStackRealloc(interp, trailPtr,
		    newSize * sizeof(Namespace *));
	    trailSize = newSize;
	}
	trailPtr[trailFront] = nsPtr;
    }
    TclStackFree(interp, trailPtr);
}
3007
3008
3009
3010
3011
3012
3013

3014
3015
3016
3017
3018
3019
3020
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038







+







    Namespace *nsPtr, *childNsPtr;
    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    const char *pattern = NULL;
    Tcl_DString buffer;
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Obj *listPtr, *elemPtr;
    (void)dummy;

    /*
     * Get a pointer to the specified namespace, or the current namespace.
     */

    if (objc == 1) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
3078
3079
3080
3081
3082
3083
3084
3085

3086
3087
3088
3089
3090
3091
3092
3096
3097
3098
3099
3100
3101
3102

3103
3104
3105
3106
3107
3108
3109
3110







-
+







#else
    if (nsPtr->childTablePtr == NULL) {
	goto searchDone;
    }
    entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
#endif
    while (entryPtr != NULL) {
	childNsPtr = Tcl_GetHashValue(entryPtr);
	childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
	if ((pattern == NULL)
		|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
	    elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
	    Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
	}
	entryPtr = Tcl_NextHashEntry(&search);
    }
3132
3133
3134
3135
3136
3137
3138

3139
3140
3141
3142
3143
3144
3145
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    Tcl_Obj *listPtr, *objPtr;
    const char *arg;
    int length;
    (void)dummy;

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

    /*
3210
3211
3212
3213
3214
3215
3216

3217
3218
3219
3220
3221
3222
3223
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243







+







NamespaceCurrentCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    (void)dummy;

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

    /*
3275
3276
3277
3278
3279
3280
3281

3282
3283
3284
3285
3286
3287
3288
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    const char *name;
    int i;
    (void)dummy;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
	return TCL_ERROR;
    }

    /*
3367
3368
3369
3370
3371
3372
3373

3374
3375
3376
3377
3378
3379
3380
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402







+







    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker;
    int word;
    Tcl_Namespace *namespacePtr;
    CallFrame *framePtr, **framePtrPtr;
    Tcl_Obj *objPtr;
    int result;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
	return TCL_ERROR;
    }

    /*
3441
3442
3443
3444
3445
3446
3447
3448

3449
3450
3451
3452
3453
3454

3455
3456
3457
3458
3459
3460
3461
3463
3464
3465
3466
3467
3468
3469

3470
3471
3472
3473
3474
3475

3476
3477
3478
3479
3480
3481
3482
3483







-
+





-
+








static int
NsEval_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = data[0];
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	int length = strlen(namespacePtr->fullName);
	int limit = 200;
	int overflow = (length > limit);
	char *cmd = data[1];
	char *cmd = (char *)data[1];

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (in namespace %s \"%.*s%s\" script line %d)",
		cmd,
		(overflow ? limit : length), namespacePtr->fullName,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }
3493
3494
3495
3496
3497
3498
3499

3500
3501
3502
3503
3504
3505
3506
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529







+







NamespaceExistsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    (void)dummy;

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

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
3548
3549
3550
3551
3552
3553
3554

3555
3556
3557
3558
3559
3560
3561
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585







+







NamespaceExportCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int firstArg, i;
    (void)dummy;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
	return TCL_ERROR;
    }

    /*
3630
3631
3632
3633
3634
3635
3636

3637
3638
3639
3640
3641
3642
3643
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *pattern;
    int i, result;
    (void)dummy;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
	return TCL_ERROR;
    }

    for (i = 1;  i < objc;  i++) {
3697
3698
3699
3700
3701
3702
3703

3704
3705
3706
3707
3708
3709
3710
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowOverwrite = 0;
    const char *string, *pattern;
    int i, result;
    int firstArg;
    (void)dummy;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
	return TCL_ERROR;
    }

    /*
3728
3729
3730
3731
3732
3733
3734
3735

3736
3737
3738
3739

3740
3741
3742
3743
3744
3745
3746
3754
3755
3756
3757
3758
3759
3760

3761
3762
3763
3764

3765
3766
3767
3768
3769
3770
3771
3772







-
+



-
+







	Tcl_HashSearch search;
	Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
	Tcl_Obj *listPtr;

	TclNewObj(listPtr);
	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Command *cmdPtr = Tcl_GetHashValue(hPtr);
	    Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	    if (cmdPtr->deleteProc == DeleteImportedCmd) {
		Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(
			Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
			(char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
	    }
	}
	Tcl_SetObjResult(interp, listPtr);
	return TCL_OK;
    }

    /*
3812
3813
3814
3815
3816
3817
3818

3819
3820
3821
3822
3823
3824
3825
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    CallFrame *framePtr, **framePtrPtr;
    int i;
    Tcl_Obj *cmdObjPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
	return TCL_ERROR;
    }

    /*
3907
3908
3909
3910
3911
3912
3913

3914
3915
3916
3917
3918
3919
3920
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command command, origCommand;
    Tcl_Obj *resultPtr;
    (void)dummy;

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

    command = Tcl_GetCommandFromObj(interp, objv[1]);
3967
3968
3969
3970
3971
3972
3973

3974
3975
3976
3977
3978
3979
3980
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009







+







NamespaceParentCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *nsPtr;
    (void)dummy;

    if (objc == 1) {
	nsPtr = TclGetCurrentNamespace(interp);
    } else if (objc == 2) {
	if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
4028
4029
4030
4031
4032
4033
4034

4035
4036
4037
4038
4039
4040
4041
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    int i, nsObjc, result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
	return TCL_ERROR;
    }

    /*
4059
4060
4061
4062
4063
4064
4065
4066

4067
4068
4069
4070
4071
4072
4073
4089
4090
4091
4092
4093
4094
4095

4096
4097
4098
4099
4100
4101
4102
4103







-
+







     * There is a path given, so parse it into an array of namespace pointers.
     */

    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = TclStackAlloc(interp,
	namespaceList = (Tcl_Namespace **)TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
4112
4113
4114
4115
4116
4117
4118
4119

4120
4121
4122
4123
4124
4125
4126
4142
4143
4144
4145
4146
4147
4148

4149
4150
4151
4152
4153
4154
4155
4156







-
+







TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    int pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		ckalloc(sizeof(NamespacePathEntry) * pathLength);
		(NamespacePathEntry *)ckalloc(sizeof(NamespacePathEntry) * pathLength);
	int i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
4251
4252
4253
4254
4255
4256
4257

4258
4259
4260
4261
4262
4263
4264
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    int length;
    (void)dummy;

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

    /*
4320
4321
4322
4323
4324
4325
4326

4327
4328
4329
4330
4331
4332
4333
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *currNsPtr;
    Tcl_Obj *resultPtr;
    int rc;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?script?");
	return TCL_ERROR;
    }

    currNsPtr = TclGetCurrentNamespace(interp);
4505
4506
4507
4508
4509
4510
4511

4512
4513
4514
4515
4516
4517
4518
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551







+







NamespaceTailCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    (void)dummy;

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

    /*
4566
4567
4568
4569
4570
4571
4572

4573
4574
4575
4576
4577
4578
4579
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Namespace *nsPtr, *savedNsPtr;
    Var *otherPtr, *arrayPtr;
    const char *myName;
    (void)dummy;

    if (objc < 2 || (objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
	return TCL_ERROR;
    }

    if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
4641
4642
4643
4644
4645
4646
4647

4648
4649
4650
4651
4652
4653
4654
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const opts[] = {
	"-command", "-variable", NULL
    };
    int lookupType = 0;
    Tcl_Obj *resultPtr;
    (void)dummy;

    if (objc < 2 || objc > 3) {
    badArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
	return TCL_ERROR;
    } else if (objc == 3) {
	/*
4815
4816
4817
4818
4819
4820
4821
4822

4823
4824
4825
4826
4827
4828
4829
4850
4851
4852
4853
4854
4855
4856

4857
4858
4859
4860
4861
4862
4863
4864







-
+








    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    nsPtr->refCount++;
    resNamePtr = ckalloc(sizeof(ResolvedNsName));
    resNamePtr = (ResolvedNsName *)ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 0;
4875
4876
4877
4878
4879
4880
4881
4882

4883
4884
4885
4886
4887
4888
4889
4910
4911
4912
4913
4914
4915
4916

4917
4918
4919
4920
4921
4922
4923
4924







-
+







    Tcl_Namespace *nsPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = ckalloc(sizeof(Tcl_HashTable));
	nPtr->childTablePtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
#endif
}

/*
4964
4965
4966
4967
4968
4969
4970
4971

4972
4973
4974
4975
4976
4977
4978
4999
5000
5001
5002
5003
5004
5005

5006
5007
5008
5009
5010
5011
5012
5013







-
+







	     * Should not happen.
	     */

	    return;
	} else {
	    Tcl_HashEntry *hPtr
		    = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
	    VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
	    VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);

	    if (tracePtr->traceProc != EstablishErrorInfoTraces) {
		/*
		 * The most recent trace set on ::errorInfo is not the one the
		 * core itself puts on last. This means some other code is
		 * tracing the variable, and the additional trace(s) might be
		 * write traces that expect the timing of writes to

Changes to generic/tclNotify.c.

272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
272
273
274
275
276
277
278

279
280
281
282
283
284
285
286







-
+







    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    ClientData clientData)	/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr = ckalloc(sizeof(EventSource));
    EventSource *sourcePtr = (EventSource *)ckalloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}

Changes to generic/tclOO.c.

295
296
297
298
299
300
301
302
303


304
305
306
307
308
309
310
295
296
297
298
299
300
301


302
303
304
305
306
307
308
309
310







-
-
+
+








static int
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = ckalloc(sizeof(Foundation));
	    (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = (Foundation *)ckalloc(sizeof(Foundation));
    Tcl_Obj *namePtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
529
530
531
532
533
534
535
536

537
538
539
540
541
542
543
544
545

546
547
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
583
584
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544

545
546
547
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
583
584
585







-
+








-
+








-
+

















-
+





+







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

static void
DeletedDefineNamespace(
    ClientData clientData)
{
    Foundation *fPtr = clientData;
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->defineNs = NULL;
}

static void
DeletedObjdefNamespace(
    ClientData clientData)
{
    Foundation *fPtr = clientData;
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->objdefNs = NULL;
}

static void
DeletedHelpersNamespace(
    ClientData clientData)
{
    Foundation *fPtr = clientData;
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->helpersNs = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * KillFoundation --
 *
 *	Delete those parts of the OO core that are not deleted automatically
 *	when the objects and classes themselves are destroyed.
 *
 * ----------------------------------------------------------------------
 */

static void
KillFoundation(
    ClientData clientData,	/* Pointer to the OO system foundation
    ClientData dummy,	/* Pointer to the OO system foundation
				 * structure. */
    Tcl_Interp *interp)		/* The interpreter containing the OO system
				 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);
    (void)dummy;

    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
620
621
622
623
624
625
626
627

628
629
630
631
632
633
634
621
622
623
624
625
626
627

628
629
630
631
632
633
634
635







-
+







{
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    Command *cmdPtr;
    CommandTrace *tracePtr;
    int creationEpoch;

    oPtr = ckalloc(sizeof(Object));
    oPtr = (Object *)ckalloc(sizeof(Object));
    memset(oPtr, 0, sizeof(Object));

    /*
     * Every object has a namespace; make one. Note that this also normally
     * computes the creation epoch value for the object, a sequence number
     * that is unique to the object (and which allows us to manage method
     * caching without comparing pointers).
731
732
733
734
735
736
737
738

739
740
741
742
743
744
745
732
733
734
735
736
737
738

739
740
741
742
743
744
745
746







-
+







    /*
     * Add the NRE command and trace directly. While this breaks a number of
     * abstractions, it is faster and we're inside Tcl here so we're allowed.
     */

    cmdPtr = (Command *) oPtr->command;
    cmdPtr->nreProc = PublicNRObjectCmd;
    cmdPtr->tracePtr = tracePtr = ckalloc(sizeof(CommandTrace));
    cmdPtr->tracePtr = tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = ObjectRenamedTrace;
    tracePtr->clientData = oPtr;
    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
785
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808
809







-
+








-
+







 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    Object *oPtr = clientData;
    Object *oPtr = (Object *)clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    ClientData clientData)
{
    Object *oPtr = clientData;
    Object *oPtr = (Object *)clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
819
820
821
822
823
824
825
826




827
828
829
830
831
832
833
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834
835
836
837







-
+
+
+
+







ObjectRenamedTrace(
    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* What it's getting renamed to. (unused) */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Object *oPtr = (Object *)clientData;
    (void)interp;
    (void)oldName;
    (void)newName;

    /*
     * If this is a rename and not a delete of the object, we just flush the
     * cache of the object name.
     */

    if (flags & TCL_TRACE_RENAME) {
1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1110
1111
1112
1113
1114
1115
1116

1117
1118
1119
1120
1121
1122
1123
1124







-
+







 */

static void
ObjectNamespaceDeleted(
    ClientData clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = clientData;
    Object *oPtr = (Object *)clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
1390
1391
1392
1393
1394
1395
1396
1397

1398
1399

1400
1401
1402
1403
1404
1405
1406
1394
1395
1396
1397
1398
1399
1400

1401
1402

1403
1404
1405
1406
1407
1408
1409
1410







-
+

-
+







    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{
    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	    clsPtr->instances.list = (Object **)ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
	    clsPtr->instances.list = (Object **)ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}

1489
1490
1491
1492
1493
1494
1495
1496

1497
1498

1499
1500
1501
1502
1503
1504
1505
1493
1494
1495
1496
1497
1498
1499

1500
1501

1502
1503
1504
1505
1506
1507
1508
1509







-
+

-
+







{
    if (Destructing(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	    superPtr->subclasses.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
	    superPtr->subclasses.list = (Class **)ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

1554
1555
1556
1557
1558
1559
1560
1561

1562
1563

1564
1565
1566
1567
1568
1569
1570
1558
1559
1560
1561
1562
1563
1564

1565
1566

1567
1568
1569
1570
1571
1572
1573
1574







-
+

-
+







{
    if (Destructing(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	    superPtr->mixinSubs.list = (Class **)ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
	    superPtr->mixinSubs.list = (Class **)ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

1602
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626

1627
1628
1629
1630
1631
1632
1633
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629

1630
1631
1632
1633
1634
1635
1636
1637







-
+
















-
+







TclOOAllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
    Object *useThisObj)		/* Object that is to act as the class
				 * representation. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = ckalloc(sizeof(Class));
    Class *clsPtr = (Class *)ckalloc(sizeof(Class));

    memset(clsPtr, 0, sizeof(Class));
    clsPtr->thisPtr = useThisObj;

    /*
     * Configure the namespace path for the class's object.
     */

    InitClassPath(interp, clsPtr);

    /*
     * Classes are subclasses of oo::object, i.e. the objects they create are
     * objects.
     */

    clsPtr->superclasses.num = 1;
    clsPtr->superclasses.list = ckalloc(sizeof(Class *));
    clsPtr->superclasses.list = (Class **)ckalloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */

1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857




1858
1859
1860
1861
1862
1863
1864
1851
1852
1853
1854
1855
1856
1857




1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868







-
-
-
-
+
+
+
+








static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState state = data[2];
    Tcl_Object *objectPtr = data[3];
    CallContext *contextPtr = (CallContext *)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[2];
    Tcl_Object *objectPtr = (Tcl_Object *)data[3];

    /*
     * Ensure an error if the object was deleted in the constructor. Don't
     * want to lose errors by accident. [Bug 2903011]
     */

    if (result != TCL_ERROR && Destructing(oPtr)) {
2070
2071
2072
2073
2074
2075
2076
2077

2078
2079
2080
2081

2082
2083
2084
2085
2086
2087
2088
2074
2075
2076
2077
2078
2079
2080

2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
2092







-
+



-
+







	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = ckrealloc(cls2Ptr->superclasses.list,
	    cls2Ptr->superclasses.list = (Class **) ckrealloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
		    (Class **)ckalloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

2368
2369
2370
2371
2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382
2372
2373
2374
2375
2376
2377
2378

2379
2380
2381
2382
2383
2384
2385
2386







-
+







     * Attach the metadata store if not done already.
     */

    if (clsPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	clsPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
	clsPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

2448
2449
2450
2451
2452
2453
2454
2455

2456
2457
2458
2459
2460
2461
2462
2452
2453
2454
2455
2456
2457
2458

2459
2460
2461
2462
2463
2464
2465
2466







-
+







     * Attach the metadata store if not done already.
     */

    if (oPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	oPtr->metadataPtr = ckalloc(sizeof(Tcl_HashTable));
	oPtr->metadataPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

2507
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535

2536
2537
2538
2539
2540
2541
2542
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538

2539
2540
2541
2542
2543
2544
2545
2546







-
+




















-
+







static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD,
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}

static int
PrivateNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL);
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}

int
TclOOInvokeObject(
    Tcl_Interp *interp,		/* Interpreter for commands, variables,
				 * results, error reporting, etc. */
    Tcl_Object object,		/* The object to invoke. */
2589
2590
2591
2592
2593
2594
2595
2596

2597
2598
2599
2600
2601
2602
2603
2593
2594
2595
2596
2597
2598
2599

2600
2601
2602
2603
2604
2605
2606
2607







-
+







static int
MyClassNRObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = clientData;
    Object *oPtr = (Object *)clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
	return TCL_ERROR;
    }
    return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
	    NULL);
2648
2649
2650
2651
2652
2653
2654
2655

2656
2657
2658
2659
2660
2661
2662
2652
2653
2654
2655
2656
2657
2658

2659
2660
2661
2662
2663
2664
2665
2666







-
+








    /*
     * Determine if we're in a context that can see the extra, private methods
     * in this class.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContextPtr = framePtr->clientData;
	CallContext *callerContextPtr = (CallContext *)framePtr->clientData;
	Method *callerMethodPtr =
		callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;

	if (callerMethodPtr->declaringObjectPtr) {
	    callerObjPtr = callerMethodPtr->declaringObjectPtr;
	}
	if (callerMethodPtr->declaringClassPtr) {
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766

2767
2768
2769
2770
2771
2772

2773
2774
2775
2776
2777
2778
2779
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784







-
+


+





-
+







    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    (void)dummy;
    /*
     * Dispose of the call chain, which drops the lock on the object's
     * structure.
     */

    TclOODeleteContext(data[0]);
    TclOODeleteContext((CallContext *)data[0]);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext, FinalizeNext --
2918
2919
2920
2921
2922
2923
2924
2925

2926
2927
2928


2929
2930
2931
2932
2933
2934
2935
2923
2924
2925
2926
2927
2928
2929

2930
2931
2932

2933
2934
2935
2936
2937
2938
2939
2940
2941







-
+


-
+
+








    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeNext(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    CallContext *contextPtr = data[0];
    CallContext *contextPtr = (CallContext *)data[0];
    (void)dummy;

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[1]);
2962
2963
2964
2965
2966
2967
2968
2969

2970
2971
2972
2973
2974
2975
2976
2968
2969
2970
2971
2972
2973
2974

2975
2976
2977
2978
2979
2980
2981
2982







-
+







    }
    if (cmdPtr->objProc != TclOOPublicObjectCmd) {
	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
	if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
	    goto notAnObject;
	}
    }
    return cmdPtr->objClientData;
    return (Tcl_Object)cmdPtr->objClientData;

  notAnObject:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s does not refer to an object", TclGetString(objPtr)));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
	    NULL);
    return NULL;

Changes to generic/tclOOBasic.c.

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
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







-
+




















-
+







+








static int
FinalizeConstruction(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Object *oPtr = data[0];
    Object *oPtr = (Object *)data[0];

    if (result != TCL_OK) {
	return result;
    }
    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Constructor --
 *
 *	Implementation for oo::class constructor.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_Constructor(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke, *nameObj;
    (void)dummy;

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118
105
106
107
108
109
110
111

112
113
114
115
116
117
118
119







-
+







	    TclGetString(nameObj), NULL, -1, NULL, -1);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = ckalloc(3 * sizeof(Tcl_Obj *));
    invoke = (Tcl_Obj **)ckalloc(3 * sizeof(Tcl_Obj *));
    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
134
135
136
137
138
139
140
141
142


143
144
145
146
147
148
149
135
136
137
138
139
140
141


142
143
144
145
146
147
148
149
150







-
-
+
+








static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = data[0];
    Object *oPtr = data[1];
    Tcl_Obj **invoke = (Tcl_Obj **)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState saved;
    int code;

    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);
    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195







-
+









+







 *	Implementation for oo::class->create method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_Create(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    int len;
    (void)dummy;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250
251

252
253
254
255
256
257
258
237
238
239
240
241
242
243

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261







-
+









+







 *	Implementation for oo::class->createWithNamespace method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_CreateNs(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName, *nsName;
    int len;
    (void)dummy;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322

323
324
325
326
327
328
329
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333







-
+







+







 *	Implementation for oo::class->new method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_New(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    (void)dummy;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
352
353
354
355
356
357
358
359

360
361
362
363
364
365
366
367

368
369
370
371
372
373
374
356
357
358
359
360
361
362

363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379







-
+








+







 *	Implementation for oo::object->destroy method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Destroy(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    CallContext *contextPtr;
    (void)dummy;

    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
392
393
394
395
396
397
398
399

400
401
402
403
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
397
398
399
400
401
402
403

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







-
+




















-
+












+








static int
AfterNRDestructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    CallContext *contextPtr = (CallContext *)data[0];

    if (contextPtr->oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
    }
    TclOODeleteContext(contextPtr);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_Eval --
 *
 *	Implementation for oo::object->eval method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Eval(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    const int skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr, **framePtrPtr = &framePtr;
    Tcl_Obj *scriptPtr;
    CmdFrame *invoker;
    (void)dummy;

    if (objc-1 < skip) {
	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
479
480
481
482
483
484
485
486

487
488
489
490
491
492
493
485
486
487
488
489
490
491

492
493
494
495
496
497
498
499







-
+







static int
FinalizeEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    if (result == TCL_ERROR) {
	Object *oPtr = data[0];
	Object *oPtr = (Object *)data[0];
	const char *namePtr;

	if (oPtr) {
	    namePtr = TclGetString(TclOOObjectName(interp, oPtr));
	} else {
	    namePtr = "my";
	}
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
520
521
522
523
524
525
526

527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568







-
+














+


















-
+







 *	just creates a suitable error message.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Unknown(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;
    (void)dummy;

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContext = framePtr->clientData;
	CallContext *callerContext = (CallContext *)framePtr->clientData;
	Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;

	if (mPtr->declaringObjectPtr) {
	    if (oPtr == mPtr->declaringObjectPtr) {
		callerObj = mPtr->declaringObjectPtr;
	    }
620
621
622
623
624
625
626
627

628
629
630
631
632
633
634
635
636
637

638
639
640
641
642
643
644
627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652







-
+










+







 *	Implementation of oo::object->variable method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_LinkVar(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    Namespace *savedNsPtr;
    int i;
    (void)dummy;

    if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?varName ...?");
	return TCL_ERROR;
    }

722
723
724
725
726
727
728
729

730
731
732
733
734
735
736
737
738
739

740
741
742
743
744
745
746
730
731
732
733
734
735
736

737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755







-
+










+







 *	Implementation of the oo::object->varname method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_VarName(
    ClientData clientData,	/* Ignored. */
    ClientData dummy,	/* Ignored. */
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr, *argPtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    const char *arg;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }
    argPtr = objv[objc-1];
769
770
771
772
773
774
775
776

777
778
779
780
781
782
783
778
779
780
781
782
783
784

785
786
787
788
789
790
791
792







-
+







	 * This is a little tricky as we need to check through the inheritance
	 * hierarchy when the method was declared by a class to see if the
	 * current object is an instance of that class.
	 */

	if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
	    CallContext *callerContext = framePtr->clientData;
	    CallContext *callerContext = (CallContext *)framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    int i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
860
861
862
863
864
865
866
867

868
869
870
871
872
873
874

875
876
877
878
879
880
881
882
883
884
885
886
887
888
889

890
891
892
893
894
895
896
897
898
899
900
901
902
903

904
905
906
907
908
909
910
911
912
913
914

915
916
917
918
919
920
921
922
923
924
925
926
927
928
929

930
931
932
933
934
935
936
869
870
871
872
873
874
875

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898

899
900
901
902
903
904
905
906
907
908
909
910
911
912

913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939

940
941
942
943
944
945
946
947







-
+







+














-
+













-
+











+














-
+







 *	method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOONextObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Tcl_ObjectContext context;
    (void)dummy;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }
    context = framePtr->clientData;
    context = (Tcl_ObjectContext)framePtr->clientData;

    /*
     * Invoke the (advanced) method call context in the caller context. Note
     * that this is like [uplevel 1] and not [eval].
     */

    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
    iPtr->varFramePtr = framePtr->callerVarPtr;
    return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}

int
TclOONextToObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Class *classPtr;
    CallContext *contextPtr;
    int i;
    Tcl_Object object;
    const char *methodType;
    (void)dummy;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }
    contextPtr = framePtr->clientData;
    contextPtr = (CallContext *)framePtr->clientData;

    /*
     * Sanity check the arguments; we need the first one to refer to a class.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
1007
1008
1009
1010
1011
1012
1013
1014

1015
1016

1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053

1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1018
1019
1020
1021
1022
1023
1024

1025
1026

1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1089







-
+

-
+



















-
+

















+
















-
+







static int
NextRestoreFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = data[1];
    CallContext *contextPtr = (CallContext *)data[1];

    iPtr->varFramePtr = data[0];
    iPtr->varFramePtr = (CallFrame *)data[0];
    if (contextPtr != NULL) {
	contextPtr->index = PTR2INT(data[2]);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOSelfObjCmd --
 *
 *	Implementation of the [self] command, which provides introspection of
 *	the call context.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOSelfObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    static const char *const subcmds[] = {
	"call", "caller", "class", "filter", "method", "namespace", "next",
	"object", "target", NULL
    };
    enum SelfCmds {
	SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS,
	SELF_NEXT, SELF_OBJECT, SELF_TARGET
    };
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *result[3];
    int index;
    (void)dummy;

#define CurrentlyInvoked(contextPtr) \
    ((contextPtr)->callPtr->chain[(contextPtr)->index])

    /*
     * Start with sanity checks on the calling context and the method context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }

    contextPtr = framePtr->clientData;
    contextPtr = (CallContext*)framePtr->clientData;

    /*
     * Now we do "conventional" argument parsing for a while. Note that no
     * subcommand takes arguments.
     */

    if (objc > 2) {
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1156
1157
1158
1159
1160
1161
1162

1163
1164
1165
1166
1167
1168
1169
1170







-
+







	if ((framePtr->callerVarPtr == NULL) ||
		!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "caller is not an object", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    return TCL_ERROR;
	} else {
	    CallContext *callerPtr = framePtr->callerVarPtr->clientData;
	    CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData;
	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
	    Object *declarerPtr;

	    if (mPtr->declaringClassPtr != NULL) {
		declarerPtr = mPtr->declaringClassPtr->thisPtr;
	    } else if (mPtr->declaringObjectPtr != NULL) {
		declarerPtr = mPtr->declaringObjectPtr;
1266
1267
1268
1269
1270
1271
1272
1273

1274
1275
1276
1277
1278

1279
1280
1281
1282
1283
1284
1285
1278
1279
1280
1281
1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298







-
+





+







 *	process.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOCopyObjectCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr, o2Ptr;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
			 "sourceName ?targetName? ?targetNamespace?");
	return TCL_ERROR;
    }

Changes to generic/tclOOCall.c.

276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
276
277
278
279
280
281
282

283
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298







-
+







-
+








static void
DupMethodNameRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dstPtr)
{
    StashCallChain(dstPtr,
	    TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
	    (CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}

static void
FreeMethodNameRep(
    Tcl_Obj *objPtr)
{
    TclOODeleteChain(
	    TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
	    (CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInvokeContext --
 *
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324







-
+







    Tcl_Interp *interp,		/* Interpreter for error reporting, and many
				 * other sorts of context handling (e.g.,
				 * commands, variables) depending on method
				 * implementation. */
    int objc,			/* The number of arguments. */
    Tcl_Obj *const objv[])	/* The arguments as actually seen. */
{
    CallContext *const contextPtr = clientData;
    CallContext *const contextPtr = (CallContext *)clientData;
    Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const int isFilter =
	    contextPtr->callPtr->chain[contextPtr->index].isFilter;

    /*
     * If this is the first step along the chain, we preserve the method
     * entries in the chain so that they do not get deleted out from under our
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
411
412
413
414
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
411
412
413
414
415
416
417







-
+


-
+
+








-
+


-
+
+








-
+


-
+

+







    return mPtr->typePtr->callProc(mPtr->clientData, interp,
	    (Tcl_ObjectContext) contextPtr, objc, objv);
}

static int
SetFilterFlags(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    CallContext *contextPtr = data[0];
    CallContext *contextPtr = (CallContext *)data[0];
    (void)dummy;

    contextPtr->oPtr->flags |= FILTER_HANDLING;
    return result;
}

static int
ResetFilterFlags(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    CallContext *contextPtr = data[0];
    CallContext *contextPtr = (CallContext *)data[0];
    (void)dummy;

    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    return result;
}

static int
FinalizeMethodRefs(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    CallContext *contextPtr = data[0];
    CallContext *contextPtr = (CallContext *)data[0];
    int i;
    (void)dummy;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}

609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626







-
+








    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

    strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
    strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}
831
832
833
834
835
836
837
838

839
840
841
842
843
844
845
834
835
836
837
838
839
840

841
842
843
844
845
846
847
848







-
+







    Tcl_HashEntry *hPtr;
    Method *mPtr;
    int donePrivate = 0;

    if (oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
	if (hPtr != NULL) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
		donePrivate = 1;
	    }
	}
    }
    return donePrivate;
881
882
883
884
885
886
887
888

889
890
891
892
893
894
895
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898







-
+







    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);

	if (hPtr != NULL) {
	    mPtr = Tcl_GetHashValue(hPtr);
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	    if (!IS_PRIVATE(mPtr)) {
		if (WANT_PUBLIC(flags)) {
		    if (!IS_PUBLIC(mPtr)) {
			blockedUnexported = 1;
		    } else {
			flags |= DEFINITE_PUBLIC;
		    }
911
912
913
914
915
916
917
918

919
920
921
922
923
924
925
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928







-
+







	    foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
		    methodNameObj, cbPtr, doneFilters,
		    flags | TRAVERSED_MIXIN, filterDecl);
	}
	if (oPtr->methodsPtr && !blockedUnexported) {
	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
	    if (hPtr != NULL) {
		mPtr = Tcl_GetHashValue(hPtr);
		mPtr = (Method *)Tcl_GetHashValue(hPtr);
		if (!IS_PRIVATE(mPtr)) {
		    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			    flags);
		}
	    }
	}
    }
1033
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044

1045
1046
1047
1048
1049
1050
1051
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1054







-
+



-
+







     * Need to really add the method. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain =
		ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
		(struct MInvoke *)ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = ckrealloc(callPtr->chain,
	callPtr->chain = (struct MInvoke *)ckrealloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;
    callPtr->chain[i].isFilter = (doneFilters != NULL);
    callPtr->chain[i].filterDeclarer = filterDecl;
    callPtr->numChain++;
}
1189
1190
1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201
1202
1203
1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
1206







-
+







	 * the object, and in the class).
	 */

	const Tcl_ObjIntRep *irPtr;
	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
	    callPtr = irPtr->twoPtrValue.ptr1;
	    callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	    Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
	}

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
1217
1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235

1236
1237
1238
1239
1240
1241
1242
1243







-
+











-
+







			(char *) methodNameObj);
	    } else {
		hPtr = NULL;
	    }
	}

	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    callPtr = Tcl_GetHashValue(hPtr);
	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}

	doFilters = 1;
    }

    callPtr = ckalloc(sizeof(CallChain));
    callPtr = (CallChain *)ckalloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

    /*
1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350
1351
1352
1353
1334
1335
1336
1337
1338
1339
1340

1341
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356







-
+







-
+







	    return NULL;
	}
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    ckalloc(sizeof(Tcl_HashTable));
			    (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
			(char *) methodNameObj, &i);
	    } else {
		if (oPtr->chainCache == NULL) {
		    oPtr->chainCache = ckalloc(sizeof(Tcl_HashTable));
		    oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->chainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
			(char *) methodNameObj, &i);
	    }
	}
1365
1366
1367
1368
1369
1370
1371
1372

1373
1374
1375
1376
1377
1378
1379
1368
1369
1370
1371
1372
1373
1374

1375
1376
1377
1378
1379
1380
1381
1382







-
+







	    TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
	}
	oPtr->selfCls->destructorChainPtr = callPtr;
	callPtr->refCount++;
    }

  returnContext:
    contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
    contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
    contextPtr->oPtr = oPtr;

    /*
     * Corresponding TclOODecrRefCount() in TclOODeleteContext
     */

    AddRef(oPtr);
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
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







-
+











-
+








    if (clsPtr->classChainCache != NULL) {
	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
		(char *) methodNameObj);
	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	    callPtr = Tcl_GetHashValue(hPtr);
	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
		callPtr->refCount++;
		return callPtr;
	    }
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = ckalloc(sizeof(CallChain));
    callPtr = (CallChain *)ckalloc(sizeof(CallChain));
    memset(callPtr, 0, sizeof(CallChain));
    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
    callPtr->epoch = fPtr->epoch;
    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
    callPtr->refCount = 1;
    callPtr->chain = callPtr->staticChain;
1501
1502
1503
1504
1505
1506
1507
1508

1509
1510
1511
1512
1513
1514
1515
1504
1505
1506
1507
1508
1509
1510

1511
1512
1513
1514
1515
1516
1517
1518







-
+







	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = ckalloc(sizeof(Tcl_HashTable));
		clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);
1649
1650
1651
1652
1653
1654
1655
1656

1657
1658
1659

1660
1661
1662
1663
1664
1665
1666
1652
1653
1654
1655
1656
1657
1658

1659
1660
1661

1662
1663
1664
1665
1666
1667
1668
1669







-
+


-
+







		filterDecl)) {
	    return 1;
	}
    }

    if (classPtr == contextCls) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodName);
		methodName);

	if (hPtr != NULL) {
	    Method *mPtr = Tcl_GetHashValue(hPtr);
	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);

	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
		return 1;
	    }
	}
1737
1738
1739
1740
1741
1742
1743
1744

1745
1746
1747
1748
1749
1750
1751
1740
1741
1742
1743
1744
1745
1746

1747
1748
1749
1750
1751
1752
1753
1754







-
+







	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);

	if (classPtr->flags & HAS_PRIVATE_METHODS) {
	    privateDanger |= 1;
	}
	if (hPtr != NULL) {
	    Method *mPtr = Tcl_GetHashValue(hPtr);
	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);

	    if (!IS_PRIVATE(mPtr)) {
		if (!(flags & KNOWN_STATE)) {
		    if (flags & PUBLIC_METHOD) {
			if (!IS_PUBLIC(mPtr)) {
			    return privateDanger;
			}
1817
1818
1819
1820
1821
1822
1823
1824

1825
1826
1827
1828
1829
1830
1831
1820
1821
1822
1823
1824
1825
1826

1827
1828
1829
1830
1831
1832
1833
1834







-
+







     * extra argument when handled by some method types, and "filter" is
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
2085
2086
2087
2088
2089
2090
2091
2092

2093
2094
2095
2096

2097
2098
2099
2100
2101
2102
2103
2088
2089
2090
2091
2092
2093
2094

2095
2096
2097
2098

2099
2100
2101
2102
2103
2104
2105
2106







-
+



-
+








    if (definePtr->num == definePtr->size) {
	definePtr->size *= 2;
	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
	    DefineEntry *staticList = definePtr->list;

	    definePtr->list =
		    ckalloc(sizeof(DefineEntry) * definePtr->size);
		    (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size);
	    memcpy(definePtr->list, staticList,
		    sizeof(DefineEntry) * definePtr->num);
	} else {
	    definePtr->list = ckrealloc(definePtr->list,
	    definePtr->list = (DefineEntry *)ckrealloc(definePtr->list,
		    sizeof(DefineEntry) * definePtr->size);
	}
    }
    definePtr->list[i].definerCls = definerCls;
    definePtr->list[i].namespaceName = namespaceName;
    definePtr->num++;
}

Changes to generic/tclOODefineCmds.c.

276
277
278
279
280
281
282
283

284
285

286
287
288
289
290
291
292
276
277
278
279
280
281
282

283
284

285
286
287
288
289
290
291
292







-
+

-
+







	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	    filtersList = (Tcl_Obj **)ckalloc(size);
	} else {
	    filtersList = ckrealloc(oPtr->filters.list, size);
	    filtersList = (Tcl_Obj **)ckrealloc(oPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
335
336
337
338
339
340
341
342

343
344

345
346
347
348
349
350
351
335
336
337
338
339
340
341

342
343

344
345
346
347
348
349
350
351







-
+

-
+







	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = ckalloc(size);
	    filtersList = (Tcl_Obj **)ckalloc(size);
	} else {
	    filtersList = ckrealloc(classPtr->filters.list, size);
	    filtersList = (Tcl_Obj **)ckrealloc(classPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;
391
392
393
394
395
396
397
398

399
400
401

402
403
404
405
406
407
408
391
392
393
394
395
396
397

398
399
400

401
402
403
404
405
406
407
408







-
+


-
+







	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr && mixinPtr != oPtr->selfCls) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    oPtr->mixins.list = ckrealloc(oPtr->mixins.list,
	    oPtr->mixins.list = (Class **)ckrealloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	    oPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins);
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);
449
450
451
452
453
454
455
456

457
458
459

460
461
462
463
464
465
466
449
450
451
452
453
454
455

456
457
458

459
460
461
462
463
464
465
466







-
+


-
+







	}
    } else {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    classPtr->mixins.list = ckrealloc(classPtr->mixins.list,
	    classPtr->mixins.list = (Class **)ckrealloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = ckalloc(sizeof(Class *) * numMixins);
	    classPtr->mixins.list = (Class **)ckalloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);

	    /*
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
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







-
+

-
+




















-
+







    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	    vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
	    vnlPtr->list = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	    vnlPtr->list = (Tcl_Obj **)ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
549
550
551
552
553
554
555
556

557
558
559

560
561
562
563
564
565
566
549
550
551
552
553
554
555

556
557
558

559
560
561
562
563
564
565
566







-
+


-
+







	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
	    pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
	    pvlPtr->list = (PrivateVariableMapping *)ckalloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
579
580
581
582
583
584
585
586

587
588
589
590
591
592
593
579
580
581
582
583
584
585

586
587
588
589
590
591
592
593







-
+







	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = ckrealloc(pvlPtr->list,
	    pvlPtr->list = (PrivateVariableMapping *)ckrealloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
660
661
662
663
664
665
666
667

668
669
670
671
672
673
674
660
661
662
663
664
665
666

667
668
669
670
671
672
673
674







-
+







	}
    }

    /*
     * Complete the splicing by changing the method's name.
     */

    mPtr = Tcl_GetHashValue(hPtr);
    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (toPtr) {
	Tcl_IncrRefCount(toPtr);
	Tcl_DecrRefCount(mPtr->namePtr);
	mPtr->namePtr = toPtr;
	Tcl_SetHashValue(newHPtr, mPtr);
    } else {
	if (!useClass) {
691
692
693
694
695
696
697
698

699
700
701
702
703
704
705
706
707

708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

742
743
744
745
746
747
748
691
692
693
694
695
696
697

698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725

726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741

742
743
744
745
746
747
748
749







-
+









+

















-
+















-
+







 *	prefix of.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOUnknownDefinition(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    int soughtLen;
    const char *soughtStr, *matchedStr = NULL;
    (void)dummy;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = TclGetStringFromObj(objv[1], &soughtLen);
    if (soughtLen == 0) {
	goto noMatch;
    }
    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    while (hPtr != NULL) {
	const char *nameStr = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
	const char *nameStr = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

	if (strncmp(soughtStr, nameStr, soughtLen) == 0) {
	    if (matchedStr != NULL) {
		goto noMatch;
	    }
	    matchedStr = nameStr;
	}
	hPtr = Tcl_NextHashEntry(&search);
    }

    if (matchedStr != NULL) {
	/*
	 * Got one match, and only one match!
	 */

	Tcl_Obj **newObjv =
	Tcl_Obj **newObjv = (Tcl_Obj **)
		TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1));
	int result;

	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
	Tcl_IncrRefCount(newObjv[0]);
	if (objc > 2) {
	    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
886
887
888
889
890
891
892
893

894
895
896
897
898
899
900
887
888
889
890
891
892
893

894
895
896
897
898
899
900
901







-
+







	    && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command may only be called from within the context of"
		" an ::oo::define or ::oo::objdefine command", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    object = iPtr->varFramePtr->clientData;
    object = (Tcl_Object)iPtr->varFramePtr->clientData;
    if (Tcl_ObjectDeleted(object)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command cannot be called when the object has been"
		" deleted", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
1088
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102

1103
1104
1105
1106
1107
1108
1109
1089
1090
1091
1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111







-
+







+







 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
1164
1165
1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178

1179
1180
1181
1182
1183
1184
1185
1166
1167
1168
1169
1170
1171
1172

1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188







-
+







+







 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOObjDefObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
1233
1234
1235
1236
1237
1238
1239
1240

1241
1242
1243
1244
1245
1246
1247

1248
1249
1250
1251
1252
1253
1254
1236
1237
1238
1239
1240
1241
1242

1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258







-
+







+







 *	dispatch so that error messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineSelfObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result, isPrivate;
    (void)dummy;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc < 2) {
1304
1305
1306
1307
1308
1309
1310
1311

1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322
1323
1308
1309
1310
1311
1312
1313
1314

1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328







-
+





+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineObjSelfObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    (void)dummy;

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

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
1411
1412
1413
1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
1426

1427
1428
1429
1430
1431
1432
1433
1416
1417
1418
1419
1420
1421
1422

1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineClassObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int wasClass, willBeClass;
    (void)dummy;

    /*
     * Parse the context to get the object to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1535

1536
1537
1538
1539
1540
1541
1542
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineConstructorObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    int bodyLength;
    (void)dummy;

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

    /*
1589
1590
1591
1592
1593
1594
1595
1596

1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624







-
+













+







 *	"oo::define" command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDefnNsObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    static const char *kindList[] = {
	"-class",
	"-instance",
	NULL
    };
    int kind = 0;
    Object *oPtr;
    Tcl_Namespace *nsPtr;
    Tcl_Obj *nsNamePtr, **storagePtr;
    (void)dummy;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
1731
1732
1733
1734
1735
1736
1737
1738

1739
1740
1741
1742
1743
1744
1745
1746

1747
1748
1749
1750
1751
1752
1753
1739
1740
1741
1742
1743
1744
1745

1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDestructorObjCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    int bodyLength;
    (void)dummy;

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

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
1837
1838
1839
1840
1841
1842
1843
1844

1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856

1857
1858
1859
1860
1861
1862
1863

1864
1865
1866
1867
1868
1869
1870
1846
1847
1848
1849
1850
1851
1852

1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864

1865
1866
1867
1868
1869
1870
1871

1872
1873
1874
1875
1876
1877
1878
1879







-
+











-
+






-
+







	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceExport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
		oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = ckalloc(sizeof(Method));
	    mPtr = (Method *)ckalloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	}
	if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
	    mPtr->flags |= PUBLIC_METHOD;
	    mPtr->flags &= ~TRUE_PRIVATE_METHOD;
	    changed = 1;
	}
    }
2150
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169

2170
2171
2172
2173
2174
2175
2176

2177
2178
2179
2180
2181
2182
2183
2159
2160
2161
2162
2163
2164
2165

2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177

2178
2179
2180
2181
2182
2183
2184

2185
2186
2187
2188
2189
2190
2191
2192







-
+











-
+






-
+







	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceUnexport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
		oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char*) objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = ckalloc(sizeof(Method));
	    mPtr = (Method *)ckalloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = Tcl_GetHashValue(hPtr);
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	}
	if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
	    mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
	    changed = 1;
	}
    }

2310
2311
2312
2313
2314
2315
2316
2317

2318
2319
2320
2321
2322
2323
2324
2325

2326
2327
2328
2329
2330
2331
2332
2319
2320
2321
2322
2323
2324
2325

2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassFilterGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
2344
2345
2346
2347
2348
2349
2350
2351

2352
2353
2354
2355
2356
2357
2358
2359

2360
2361
2362
2363
2364
2365
2366
2354
2355
2356
2357
2358
2359
2360

2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377







-
+








+







    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassFilterSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
2390
2391
2392
2393
2394
2395
2396
2397

2398
2399
2400
2401
2402
2403
2404
2405
2406

2407
2408
2409
2410
2411
2412
2413
2401
2402
2403
2404
2405
2406
2407

2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425







-
+









+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassMixinGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
2427
2428
2429
2430
2431
2432
2433
2434

2435
2436
2437
2438
2439
2440
2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464

2465
2466
2467
2468
2469
2470
2471
2439
2440
2441
2442
2443
2444
2445

2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476

2477
2478
2479
2480
2481
2482
2483
2484







-
+









+




















-
+







    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

}

static int
ClassMixinSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;
    (void)dummy;

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

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
    mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i = 0; i < mixinc; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    i--;
	    goto freeAndError;
2496
2497
2498
2499
2500
2501
2502
2503

2504
2505
2506
2507
2508
2509
2510
2511
2512

2513
2514
2515
2516
2517
2518
2519
2509
2510
2511
2512
2513
2514
2515

2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533







-
+









+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassSuperGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *superPtr;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
2532
2533
2534
2535
2536
2537
2538
2539

2540
2541
2542
2543
2544
2545
2546
2547
2548

2549
2550
2551
2552
2553
2554
2555
2546
2547
2548
2549
2550
2551
2552

2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570







-
+









+







    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassSuperSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int superc, i, j;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
2581
2582
2583
2584
2585
2586
2587
2588

2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602

2603
2604
2605
2606
2607
2608
2609
2610







-
+







     * Parse the arguments to get the class to use as superclasses.
     *
     * Note that zero classes is special, as it is equivalent to just the
     * class of objects. [Bug 9d61624b3d]
     */

    if (superc == 0) {
	superclasses = ckrealloc(superclasses, sizeof(Class *));
	superclasses = (Class **)ckrealloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
2663
2664
2665
2666
2667
2668
2669
2670

2671
2672
2673
2674
2675
2676
2677
2678

2679
2680
2681
2682
2683
2684
2685
2678
2679
2680
2681
2682
2683
2684

2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassVarsGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
2707
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722
2723

2724
2725
2726
2727
2728
2729
2730
2723
2724
2725
2726
2727
2728
2729

2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747







-
+









+







    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassVarsSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
2778
2779
2780
2781
2782
2783
2784
2785

2786
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813

2814
2815
2816
2817
2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2795
2796
2797
2798
2799
2800
2801

2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830

2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847







-
+








+



















-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjFilterGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(filterObj, oPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjFilterSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
2846
2847
2848
2849
2850
2851
2852
2853

2854
2855
2856
2857
2858
2859
2860
2861
2862

2863
2864
2865
2866
2867
2868
2869
2865
2866
2867
2868
2869
2870
2871

2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889







-
+









+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjMixinGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
2878
2879
2880
2881
2882
2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
2893
2894
2895

2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910

2911
2912
2913
2914
2915
2916
2917
2898
2899
2900
2901
2902
2903
2904

2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930

2931
2932
2933
2934
2935
2936
2937
2938







-
+










+














-
+







    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjMixinSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);
    mixins = (Class **)TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i = 0; i < mixinc; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    TclStackFree(interp, mixins);
	    return TCL_ERROR;
2932
2933
2934
2935
2936
2937
2938
2939

2940
2941
2942
2943
2944
2945
2946
2947

2948
2949
2950
2951
2952
2953
2954
2953
2954
2955
2956
2957
2958
2959

2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976







-
+








+







 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjVarsGet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    int i;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
2970
2971
2972
2973
2974
2975
2976
2977

2978
2979
2980
2981
2982
2983
2984
2985

2986
2987
2988
2989
2990
2991
2992
2992
2993
2994
2995
2996
2997
2998

2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015







-
+








+







    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjVarsSet(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv;
    (void)dummy;

    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
3035
3036
3037
3038
3039
3040
3041
3042

3043
3044
3045
3046
3047
3048
3049
3050

3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064

3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081







-
+








+







 *	names to their fully-qualified names if possible.
 *
 * ----------------------------------------------------------------------
 */

static int
ResolveClass(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    int idx = Tcl_ObjectContextSkippedArgs(context);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Class *clsPtr;
    (void)dummy;

    /*
     * Check if were called wrongly. The definition context isn't used...
     * except that GetClassInOuterContext() assumes that it is there.
     */

    if (oPtr == NULL) {

Changes to generic/tclOOInfo.c.

167
168
169
170
171
172
173
174

175
176
177
178
179

180
181
182
183
184
185
186
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183
184
185
186
187







-
+





+







 *	Implements [info object class $objName ?$className?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectClassCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
239
240

241
242
243
244
245
246
247
225
226
227
228
229
230
231

232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249







-
+









+







 *	Implements [info object definition $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectDefnCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];
    (void)dummy;

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

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
257
258
259
260
261
262
263
264

265
266
267
268
269
270
271
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273







-
+







    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
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
310
311
312

313
314
315
316
317
318
319
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
310
311
312
313
314
315
316
317
318
319
320
321
322







-
+
















-
+







+







		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
	}
    }
    resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectFiltersCmd --
 *
 *	Implements [info object filters $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectFiltersCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i;
    Tcl_Obj *filterObj, *resultObj;
    Object *oPtr;
    (void)dummy;

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

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
337
338
339
340
341
342
343
344

345
346
347
348
349
350
351

352
353
354
355
356
357
358
340
341
342
343
344
345
346

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362







-
+







+







 *	Implements [info object forward $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectForwardCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *prefixObj;
    (void)dummy;

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

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
368
369
370
371
372
373
374
375

376
377
378
379
380
381
382
372
373
374
375
376
377
378

379
380
381
382
383
384
385
386







-
+







    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (prefixObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"prefix argument list not available for this kind of method",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
394
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413

414
415
416
417
418
419
420
398
399
400
401
402
403
404

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425







-
+












+







 *	Implements [info object isa $category $objName ...]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIsACmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const categories[] = {
	"class", "metaclass", "mixin", "object", "typeof", NULL
    };
    enum IsACats {
	IsClass, IsMetaclass, IsMixin, IsObject, IsType
    };
    Object *oPtr, *o2Ptr;
    int idx, i, result = 0;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
	    &idx) != TCL_OK) {
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
518
519
520
521
522
523
524

525
526
527
528
529
530
531
532







-
+







 *	Implements [info object methods $objName ?$option ...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMethodsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    FOREACH_HASH_DECLS;
536
537
538
539
540
541
542

543
544
545
546
547
548
549
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555







+







    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
	SCOPE_LOCALPRIVATE
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
633
634
635
636
637
638
639
640

641
642
643
644
645
646
647

648
649
650
651
652
653
654
639
640
641
642
643
644
645

646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661







-
+







+







 *	Implements [info object methodtype $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMethodTypeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    (void)dummy;

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

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
664
665
666
667
668
669
670
671

672
673
674
675
676
677
678
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685







-
+







    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    mPtr = Tcl_GetHashValue(hPtr);
    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (mPtr->typePtr == NULL) {
	/*
	 * Special entry for visibility control: pretend the method doesnt
	 * exist.
	 */

	goto unknownMethod;
690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
705

706
707
708
709
710
711
712
697
698
699
700
701
702
703

704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720







-
+








+







 *	Implements [info object mixins $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMixinsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *mixinPtr;
    Object *oPtr;
    Tcl_Obj *resultObj;
    int i;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
733
734
735
736
737
738
739
740

741
742
743
744
745

746
747
748
749
750
751
752
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755
756
757
758
759
760
761







-
+





+







 *	Implements [info object creationid $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIdCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
765
766
767
768
769
770
771
772

773
774
775
776
777

778
779
780
781
782
783
784
774
775
776
777
778
779
780

781
782
783
784
785
786
787
788
789
790
791
792
793
794







-
+





+







 *	Implements [info object namespace $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectNsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
798
799
800
801
802
803
804
805

806
807
808
809
810
811
812

813
814
815
816
817
818
819
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830







-
+







+







 *	Implements [info object variables $objName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVariablesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *resultObj;
    int i, isPrivate = 0;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
852
853
854
855
856
857
858
859

860
861
862
863
864
865
866
867
868

869
870
871
872
873
874
875
863
864
865
866
867
868
869

870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887







-
+









+







 *	Implements [info object vars $objName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVarsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    const char *pattern = NULL;
    FOREACH_HASH_DECLS;
    VarInHash *vihPtr;
    Tcl_Obj *nameObj, *resultObj;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928

929
930
931
932
933
934
935
925
926
927
928
929
930
931

932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948







-
+








+







 *	Implements [info class constructor $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassConstrCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];
    Class *clsPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
974
975
976
977
978
979
980
981

982
983
984
985
986
987
988
989
990

991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008

1009
1010
1011
1012
1013
1014
1015
987
988
989
990
991
992
993

994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021

1022
1023
1024
1025
1026
1027
1028
1029







-
+









+

















-
+







 *	Implements [info class definition $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDefnCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];
    Class *clsPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067
1068
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062

1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083







-
+
















-
+












+







		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
	}
    }
    resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassDefnNsCmd --
 *
 *	Implements [info class definitionnamespace $clsName ?$kind?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDefnNsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *kindList[] = {
	"-class",
	"-instance",
	NULL
    };
    int kind = 0;
    Tcl_Obj *nsNamePtr;
    Class *clsPtr;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?kind?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105

1106
1107
1108
1109
1110
1111
1112
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128







-
+






+







 *	Implements [info class destructor $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDestrCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Proc *procPtr;
    Class *clsPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1136
1137
1138
1139
1140
1141
1142
1143

1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155
1156
1157
1152
1153
1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174







-
+







+







 *	Implements [info class filters $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassFiltersCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i;
    Tcl_Obj *filterObj, *resultObj;
    Class *clsPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
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
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
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







-
+







+

















-
+







 *	Implements [info class forward $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassForwardCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *prefixObj;
    Class *clsPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    prefixObj = TclOOGetFwdFromMethod(Tcl_GetHashValue(hPtr));
    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (prefixObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"prefix argument list not available for this kind of method",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
1225
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243
1244
1245
1246
1247
1248
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267







-
+









+







 *	Implements [info class instances $clsName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassInstancesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Class *clsPtr;
    int i;
    const char *pattern = NULL;
    Tcl_Obj *resultObj;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1273
1274
1275
1276
1277
1278
1279
1280

1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300

1301
1302
1303
1304
1305
1306
1307
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327







-
+




















+







 *	Implements [info class methods $clsName ?options...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    Class *clsPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1389
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
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







-
+







+



















-
+







 *	Implements [info class methodtype $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodTypeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    Class *clsPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    mPtr = Tcl_GetHashValue(hPtr);
    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (mPtr->typePtr == NULL) {
	/*
	 * Special entry for visibility control: pretend the method doesnt
	 * exist.
	 */

	goto unknownMethod;
1441
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461
1462
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484







-
+







+







 *	Implements [info class mixins $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMixinsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *mixinPtr;
    Tcl_Obj *resultObj;
    int i;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1483
1484
1485
1486
1487
1488
1489
1490

1491
1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1505
1506
1507
1508
1509
1510
1511

1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528







-
+








+







 *	Implements [info class subclasses $clsName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassSubsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *subclassPtr;
    Tcl_Obj *resultObj;
    int i;
    const char *pattern = NULL;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1538
1539
1540
1541
1542
1543
1544
1545

1546
1547
1548
1549
1550
1551
1552

1553
1554
1555
1556
1557
1558
1559
1561
1562
1563
1564
1565
1566
1567

1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583







-
+







+







 *	Implements [info class superclasses $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassSupersCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *superPtr;
    Tcl_Obj *resultObj;
    int i;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
1577
1578
1579
1580
1581
1582
1583
1584

1585
1586
1587
1588
1589
1590
1591

1592
1593
1594
1595
1596
1597
1598
1601
1602
1603
1604
1605
1606
1607

1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623







-
+







+







 *	Implements [info class variables $clsName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassVariablesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *resultObj;
    int i, isPrivate = 0;
    (void)dummy;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
1631
1632
1633
1634
1635
1636
1637
1638

1639
1640
1641
1642
1643
1644

1645
1646
1647
1648
1649
1650
1651
1656
1657
1658
1659
1660
1661
1662

1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677







-
+






+







 *	Implements [info object call $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectCallCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    CallContext *contextPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
1677
1678
1679
1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690

1691
1692
1693
1694
1695
1696
1697
1703
1704
1705
1706
1707
1708
1709

1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724







-
+






+







 *	Implements [info class call $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassCallCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    CallChain *callPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {

Changes to generic/tclOOInt.h.

651
652
653
654
655
656
657
658
659


660
661
662

663
664
665
666
667
668
669
651
652
653
654
655
656
657


658
659
660
661

662
663
664
665
666
667
668
669







-
-
+
+


-
+







 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    ((key)=(void *)Tcl_GetHashKey((tablePtr),hPtr),\
	    (val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
	    (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\
	    *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    ((val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))
	    (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))

/*
 * Convenience macro for duplicating a list. Needs no external declaration,
 * but all arguments are used multiple times and so must have no side effects.
 */

#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */

Changes to generic/tclOOMethod.c.

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
179
180
181
182
183
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
179
180
181
182
183
184







-
+

















+


-
+





-
+





-
+





-
+







 *	Attach a method to an object instance.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
Tcl_NewInstanceMethod(
    Tcl_Interp *interp,		/* Unused? */
    Tcl_Interp *dummy,		/* Unused. */
    Tcl_Object object,		/* The object that has the method attached to
				 * it. */
    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
				 * up to caller to manage storage (e.g., when
				 * it is a constructor or destructor). */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    void *clientData)	/* Some data associated with the particular
				 * method to be created. */
{
    Object *oPtr = (Object *) object;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    (void)dummy;

    if (nameObj == NULL) {
	mPtr = ckalloc(sizeof(Method));
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    if (!oPtr->methodsPtr) {
	oPtr->methodsPtr = ckalloc(sizeof(Tcl_HashTable));
	oPtr->methodsPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitObjHashTable(oPtr->methodsPtr);
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
    if (isNew) {
	mPtr = ckalloc(sizeof(Method));
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->namePtr = nameObj;
	mPtr->refCount = 1;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	mPtr = (Method *)Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
    }

  populate:
    mPtr->typePtr = typePtr;
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

228
229
230

231
232
233
234
235
236
237

238
239
240
241
242
243

244
245
246
247
248
249
250
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238

239
240
241
242
243
244

245
246
247
248
249
250
251
252







-
+
















+


-
+






-
+





-
+







 *	Attach a method to a class.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
Tcl_NewMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Interp *dummy,		/* The interpreter containing the class. */
    Tcl_Class cls,		/* The class to attach the method to. */
    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
				 * for constructors or destructors); if so, up
				 * to caller to manage storage. */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    void *clientData)	/* Some data associated with the particular
				 * method to be created. */
{
    Class *clsPtr = (Class *) cls;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    (void)dummy;

    if (nameObj == NULL) {
	mPtr = ckalloc(sizeof(Method));
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
    if (isNew) {
	mPtr = ckalloc(sizeof(Method));
	mPtr = (Method *)ckalloc(sizeof(Method));
	mPtr->refCount = 1;
	mPtr->namePtr = nameObj;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = Tcl_GetHashValue(hPtr);
	mPtr = (Method *)Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
    }

  populate:
    clsPtr->thisPtr->fPtr->epoch++;
346
347
348
349
350
351
352
353

354
355
356
357
358
359
360
348
349
350
351
352
353
354

355
356
357
358
359
360
361
362







-
+







    int argsLen;
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = ckalloc(sizeof(ProcedureMethod));
    pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423







-
+







	procName = "<destructor>";
    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    } else {
	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
    }

    pmPtr = ckalloc(sizeof(ProcedureMethod));
    pmPtr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
501
502
503
504
505
506
507
508

509
510
511
512
513

514
515
516
517
518
519
520
503
504
505
506
507
508
509

510
511
512
513
514

515
516
517
518
519
520
521
522







-
+




-
+







	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
		CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line = (int *)ckalloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
614
615
616
617
618
619
620
621

622
623
624
625
626

627
628
629
630
631
632
633
616
617
618
619
620
621
622

623
624
625
626
627

628
629
630
631
632
633
634
635







-
+




-
+







	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
		CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line = (int *)ckalloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
668
669
670
671
672
673
674
675

676
677
678
679
680
681
682
670
671
672
673
674
675
676

677
678
679
680
681
682
683
684







-
+







InvokeProcedureMethod(
    void *clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
    int result;
    PMFrameData *fdPtr;		/* Important data that has to have a lifetime
				 * matched by this function (or rather, by the
				 * call frame's lifetime). */

    /*
     * If the object namespace (or interpreter) were deleted, we just skip to
690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
692
693
694
695
696
697
698

699
700
701
702
703
704
705
706







-
+







		Tcl_ObjectContextSkippedArgs(context));
    }

    /*
     * Allocate the special frame data.
     */

    fdPtr = TclStackAlloc(interp, sizeof(PMFrameData));
    fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData));

    /*
     * Create a call frame for this method.
     */

    result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
	    objc, objv, fdPtr);
747
748
749
750
751
752
753
754
755
756



757
758
759
760
761
762
763
749
750
751
752
753
754
755



756
757
758
759
760
761
762
763
764
765







-
-
-
+
+
+








static int
FinalizePMCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    ProcedureMethod *pmPtr = data[0];
    Tcl_ObjectContext context = data[1];
    PMFrameData *fdPtr = data[2];
    ProcedureMethod *pmPtr = (ProcedureMethod *)data[0];
    Tcl_ObjectContext context = (Tcl_ObjectContext)data[1];
    PMFrameData *fdPtr = (PMFrameData *)data[2];

    /*
     * Give the post-call callback a chance to do some cleanup. Note that at
     * this point the call frame itself is invalid; it's already been popped.
     */

    if (pmPtr->postCallProc) {
961
962
963
964
965
966
967

968
969
970
971
972
973
974
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977







+







    const char *varName,
    Tcl_Namespace *contextNs,
    int flags,
    Tcl_Var *varPtr)
{
    int result;
    Tcl_ResolvedVarInfo *rPtr = NULL;
    (void)flags;

    result = ProcedureMethodCompiledVarResolver(interp, varName,
	    strlen(varName), contextNs, &rPtr);

    if (result != TCL_OK) {
	return result;
    }
1003
1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1020







-
+







     * method call; if not (i.e. we're evaluating in the object's namespace or
     * in a procedure of that namespace) then we do nothing.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	return NULL;
    }
    contextPtr = framePtr->clientData;
    contextPtr = (CallContext *)framePtr->clientData;

    /*
     * If we've done the work before (in a comparable context) then reuse that
     * rather than performing resolution ourselves.
     */

    if (infoPtr->cachedObjectVar) {
1103
1104
1105
1106
1107
1108
1109
1110

1111
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
1106
1107
1108
1109
1110
1111
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







-
+







+
+












-
+







    }
    Tcl_DecrRefCount(infoPtr->variableObj);
    ckfree(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    const char *varName,
    int length,
    Tcl_Namespace *contextNs,
    Tcl_ResolvedVarInfo **rPtrPtr)
{
    OOResVarInfo *infoPtr;
    Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);
    (void)dummy;
    (void)contextNs;

    /*
     * Do not create resolvers for cases that contain namespace separators or
     * which look like array accesses. Both will lead us astray.
     */

    if (strstr(Tcl_GetString(variableObj), "::") != NULL ||
	    Tcl_StringMatch(Tcl_GetString(variableObj), "*(*)")) {
	Tcl_DecrRefCount(variableObj);
	return TCL_CONTINUE;
    }

    infoPtr = ckalloc(sizeof(OOResVarInfo));
    infoPtr = (OOResVarInfo *)ckalloc(sizeof(OOResVarInfo));
    infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
    infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
    infoPtr->cachedObjectVar = NULL;
    infoPtr->variableObj = variableObj;
    Tcl_IncrRefCount(variableObj);
    *rPtrPtr = &infoPtr->info;
    return TCL_OK;
1150
1151
1152
1153
1154
1155
1156
1157

1158
1159
1160
1161
1162
1163
1164
1155
1156
1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169







-
+







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

static Tcl_Obj *
RenderDeclarerName(
    void *clientData)
{
    struct PNI *pni = clientData;
    struct PNI *pni = (struct PNI *)clientData;
    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);

    if (object == NULL) {
	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
    }
    return TclOOObjectName(pni->interp, (Object *) object);
}
1184
1185
1186
1187
1188
1189
1190
1191

1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208







-
+




+








static void
MethodErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    int nameLen, objectNameLen;
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    TclGetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;
    (void)methodNameObj;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
1214
1215
1216
1217
1218
1219
1220
1221

1222
1223
1224
1225

1226
1227
1228
1229
1230
1231
1232
1220
1221
1222
1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239







-
+




+







}

static void
ConstructorErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    int objectNameLen;
    (void)methodNameObj;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
1243
1244
1245
1246
1247
1248
1249
1250

1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269







-
+




+







}

static void
DestructorErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *methodNameObj)
{
    CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    int objectNameLen;
    (void)methodNameObj;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
1292
1293
1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1327







-
+












-
+







    ckfree(pmPtr);
}

static void
DeleteProcedureMethod(
    void *clientData)
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;

    if (pmPtr->refCount-- <= 1) {
	DeleteProcedureMethodRecord(pmPtr);
    }
}

static int
CloneProcedureMethod(
    Tcl_Interp *interp,
    void *clientData,
    void **newClientData)
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
    ProcedureMethod *pm2Ptr;
    Tcl_Obj *bodyObj, *argsObj;
    CompiledLocal *localPtr;

    /*
     * Copy the argument list.
     */
1343
1344
1345
1346
1347
1348
1349
1350

1351
1352
1353
1354
1355
1356
1357
1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1365







-
+







    Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = ckalloc(sizeof(ProcedureMethod));
    pm2Ptr = (ProcedureMethod *)ckalloc(sizeof(ProcedureMethod));
    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;
    Tcl_IncrRefCount(argsObj);
    Tcl_IncrRefCount(bodyObj);
    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
	    &pm2Ptr->procPtr) != TCL_OK) {
	Tcl_DecrRefCount(argsObj);
1397
1398
1399
1400
1401
1402
1403
1404

1405
1406
1407
1408
1409
1410
1411
1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
1419







-
+







    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
	    nameObj, flags, &fwdMethodType, fmPtr);
}

/*
1436
1437
1438
1439
1440
1441
1442
1443

1444
1445
1446
1447
1448
1449
1450
1444
1445
1446
1447
1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
1458







-
+







    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = ckalloc(sizeof(ForwardMethod));
    fmPtr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*
1463
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480
1481
1482
1483
1484
1485







-
+







    void *clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    Tcl_Obj **argObjs, **prefixObjs;
    int numPrefixes, len, skip = contextPtr->skip;

    /*
     * Build the real list of arguments to use. Note that we know that the
     * prefixObj field of the ForwardMethod structure holds a reference to a
     * non-empty list, so there's a whole class of failures ("not a list") we
1494
1495
1496
1497
1498
1499
1500
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
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
1550







-
+



















-
+







-
+



-
-
+
+
+








static int
FinalizeForwardCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **argObjs = data[0];
    Tcl_Obj **argObjs = (Tcl_Obj **)data[0];

    TclStackFree(interp, argObjs);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteForwardMethod, CloneForwardMethod --
 *
 *	How to delete and clone forwarded methods.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteForwardMethod(
    void *clientData)
{
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    ckfree(fmPtr);
}

static int
CloneForwardMethod(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    void *clientData,
    void **newClientData)
{
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    ForwardMethod *fm2Ptr = (ForwardMethod *)ckalloc(sizeof(ForwardMethod));
    (void)dummy;

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
    return TCL_OK;
}

1551
1552
1553
1554
1555
1556
1557
1558

1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

1584
1585
1586
1587
1588
1589
1590
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578

1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591

1592
1593
1594
1595
1596
1597
1598
1599







-
+











-
+












-
+







 */

Proc *
TclOOGetProcFromMethod(
    Method *mPtr)
{
    if (mPtr->typePtr == &procMethodType) {
	ProcedureMethod *pmPtr = mPtr->clientData;
	ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;

	return pmPtr->procPtr;
    }
    return NULL;
}

Tcl_Obj *
TclOOGetMethodBody(
    Method *mPtr)
{
    if (mPtr->typePtr == &procMethodType) {
	ProcedureMethod *pmPtr = mPtr->clientData;
	ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;

	(void) TclGetString(pmPtr->procPtr->bodyPtr);
	return pmPtr->procPtr->bodyPtr;
    }
    return NULL;
}

Tcl_Obj *
TclOOGetFwdFromMethod(
    Method *mPtr)
{
    if (mPtr->typePtr == &fwdMethodType) {
	ForwardMethod *fwPtr = mPtr->clientData;
	ForwardMethod *fwPtr = (ForwardMethod *)mPtr->clientData;

	return fwPtr->prefixObj;
    }
    return NULL;
}

/*
1618
1619
1620
1621
1622
1623
1624
1625

1626
1627
1628
1629
1630
1631
1632
1627
1628
1629
1630
1631
1632
1633

1634
1635
1636
1637
1638
1639
1640
1641







-
+







    int toRewrite,		/* Number of real arguments to replace. */
    int rewriteLength,		/* Number of arguments to insert instead. */
    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
    int *lengthPtr)		/* Where to write the resulting length of the
				 * array of rewritten arguments. */
{
    unsigned len = rewriteLength + objc - toRewrite;
    Tcl_Obj **argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
    Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);

    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
    memcpy(argObjs + rewriteLength, objv + toRewrite,
	    sizeof(Tcl_Obj *) * (objc - toRewrite));

    /*
     * Now plumb this into the core ensemble rewrite logging system so that

Changes to generic/tclObj.c.

165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181

182
183
184
185
186
187
188
165
166
167
168
169
170
171

172
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
188







-
+








-
+







static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr =                                  \
	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
	    (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif

/*
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7fff) {                                       \
	mp_int *temp = (void *) ckalloc(sizeof(mp_int));     \
	mp_int *temp = (mp_int *) ckalloc(sizeof(mp_int));     \
	*temp = bignum;                                                 \
	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                 \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
    } else if (((bignum).alloc <= 0x7fff) || (mp_shrink(&(bignum))) == MP_OKAY) { \
	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (bignum).dp; \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used));            \
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542







-
+







     * would be the natural place for this is invoked afterwards, meaning that
     * we try to operate on a data structure already gone.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
	tsdPtr->lineCLPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*
563
564
565
566
567
568
569
570

571
572
573
574
575
576
577
563
564
565
566
567
568
569

570
571
572
573
574
575
576
577







-
+







    int num,
    int *loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = ckalloc(sizeof(ContLineLoc) + num*sizeof(int));
    ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(sizeof(ContLineLoc) + num*sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
720
721
722
723
724
725
726
727

728
729
730
731
732
733
734
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







-
+







    Tcl_Obj *originObjPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);

    if (hPtr) {
	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);
	ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr);

	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
    }
}

/*
 *----------------------------------------------------------------------
756
757
758
759
760
761
762
763

764
765
766
767
768
769
770
756
757
758
759
760
761
762

763
764
765
766
767
768
769
770







-
+







    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);

    if (!hPtr) {
        return NULL;
    }
    return Tcl_GetHashValue(hPtr);
    return (ContLineLoc *)Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadFinalizeContLines --
 *
779
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
779
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







-
+








+
















-
+







 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static void
TclThreadFinalizeContLines(
    ClientData clientData)
    ClientData dummy)
{
    /*
     * Release the hashtable tracking invisible continuation lines.
     */

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    (void)dummy;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	ckfree(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    ckfree(tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --
 *
 *	This function is called to a new Tcl object type in the table
 *	This function is called to register a new Tcl object type in the table
 *	of all object types supported by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The type is registered in the Tcl type table. If there was already a
884
885
886
887
888
889
890
891

892
893
894
895
896
897
898
885
886
887
888
889
890
891

892
893
894
895
896
897
898
899







-
+







     * that.
     */

    Tcl_MutexLock(&tableMutex);
    for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
		Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1));
    }
    Tcl_MutexUnlock(&tableMutex);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932







-
+







{
    Tcl_HashEntry *hPtr;
    const Tcl_ObjType *typePtr = NULL;

    Tcl_MutexLock(&tableMutex);
    hPtr = Tcl_FindHashEntry(&typeTable, typeName);
    if (hPtr != NULL) {
	typePtr = Tcl_GetHashValue(hPtr);
	typePtr = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr);
    }
    Tcl_MutexUnlock(&tableMutex);
    return typePtr;
}

/*
 *----------------------------------------------------------------------
1017
1018
1019
1020
1021
1022
1023


1024
1025
1026
1027
1028
1029
1030
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033







+
+







			objData->file, objData->line);
	    } else {
		fprintf(outFile, "key = 0x%p\n",
			Tcl_GetHashKey(tablePtr, hPtr));
	    }
	}
    }
#else
	(void)outFile;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclDbInitNewObj --
1065
1066
1067
1068
1069
1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085

1086
1087
1088
1089
1090
1091
1092
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095







-
+












-
+







	Tcl_HashEntry *hPtr;
	Tcl_HashTable *tablePtr;
	int isNew;
	ObjData *objData;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->objThreadMap == NULL) {
	    tsdPtr->objThreadMap = ckalloc(sizeof(Tcl_HashTable));
	    tsdPtr->objThreadMap = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
	}
	tablePtr = tsdPtr->objThreadMap;
	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
	if (!isNew) {
	    Tcl_Panic("expected to create new entry for object map");
	}

	/*
	 * Record the debugging information.
	 */

	objData = ckalloc(sizeof(ObjData));
	objData = (ObjData *)ckalloc(sizeof(ObjData));
	objData->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}
1193
1194
1195
1196
1197
1198
1199



1200
1201
1202
1203
1204
1205
1206
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212







+
+
+







Tcl_Obj *
Tcl_DbNewObj(
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewObj();
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
1237
1238
1239
1240
1241
1242
1243
1244

1245
1246
1247
1248
1249
1250
1251
1243
1244
1245
1246
1247
1248
1249

1250
1251
1252
1253
1254
1255
1256
1257







-
+







     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
     * but leaves it to Tcl's memory subsystem finalization to release it.
     * Purify apparently can't figure that out, and fires a false alarm.
     */

    basePtr = ckalloc(bytesToAlloc);
    basePtr = (char *)ckalloc(bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	prevPtr = objPtr;
	objPtr++;
1765
1766
1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786

1787
1788
1789
1790
1791
1792
1793
1771
1772
1773
1774
1775
1776
1777

1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799







-
+













-
+







    }

    /* Allocate */
    if (objPtr->bytes == NULL) {
	/* Allocate only as empty - extend later if bytes copied */
	objPtr->length = 0;
	if (numBytes) {
	    objPtr->bytes = attemptckalloc(numBytes + 1);
	    objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
	    if (objPtr->bytes == NULL) {
		return NULL;
	    }
	    if (bytes) {
		/* Copy */
		memcpy(objPtr->bytes, bytes, numBytes);
		objPtr->length = (int) numBytes;
	    }
	} else {
	    TclInitStringRep(objPtr, NULL, 0);
	}
    } else {
	/* objPtr->bytes != NULL bytes == NULL - Truncate */
	objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1);
	objPtr->bytes = (char *)ckrealloc(objPtr->bytes, numBytes + 1);
	objPtr->length = (int)numBytes;
    }

    /* Terminate */
    objPtr->bytes[objPtr->length] = '\0';

    return objPtr->bytes;
2031
2032
2033
2034
2035
2036
2037



2038
2039
2040
2041
2042
2043
2044
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053







+
+
+







Tcl_DbNewBooleanObj(
    int boolValue,	/* Boolean used to initialize new object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2418
2419
2420
2421
2422
2423
2424



2425
2426
2427
2428
2429
2430
2431
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443







+
+
+







Tcl_DbNewDoubleObj(
    double dblValue,	/* Double used to initialize the object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewDoubleObj(dblValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2902
2903
2904
2905
2906
2907
2908



2909
2910
2911
2912
2913
2914
2915
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930







+
+
+







    long longValue,	/* Long integer used to initialize the new
				 * object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewWideIntObj(longValue);
}
#endif /* TCL_MEM_DEBUG */
#endif /* TCL_NO_DEPRECATED */

/*
 *----------------------------------------------------------------------
3011
3012
3013
3014
3015
3016
3017

3018
3019
3020
3021
3022
3023
3024
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040







+







	    /*
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

		{
	    mp_int big;
	    unsigned long scratch, value = 0;
	    unsigned char *bytes = (unsigned char *) &scratch;
	    size_t numBytes;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
3032
3033
3034
3035
3036
3037
3038

3039
3040
3041
3042
3043
3044
3045
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062







+







		    }
		} else {
		    if (value <= (unsigned long)ULONG_MAX) {
			*longPtr = (long) value;
			return TCL_OK;
		    }
		}
	    }
	    }
#ifndef TCL_WIDE_INT_IS_LONG
	tooLarge:
#endif
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
3166
3167
3168
3169
3170
3171
3172



3173
3174
3175
3176
3177
3178
3179
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199







+
+
+







				/* Long integer used to initialize the new
				 * object. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewWideIntObj(wideValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
3546
3547
3548
3549
3550
3551
3552



3553
3554
3555
3556
3557
3558
3559
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582







+
+
+







#else
Tcl_Obj *
Tcl_DbNewBignumObj(
    void *bignumValue,
    const char *file,
    int line)
{
    (void)file;
    (void)line;

    return Tcl_NewBignumObj(bignumValue);
}
#endif

/*
 *----------------------------------------------------------------------
 *
3830
3831
3832
3833
3834
3835
3836
3837
3838


3839
3840
3841
3842
3843
3844
3845
3853
3854
3855
3856
3857
3858
3859


3860
3861
3862
3863
3864
3865
3866
3867
3868







-
-
+
+







	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));
	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
		    sizeof(mp_int));

	    TclUnpackBignum(objPtr, *bigPtr);
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==
3967
3968
3969
3970
3971
3972
3973



3974
3975
3976
3977
3978
3979
3980
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006







+
+
+







	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "incr ref count");
	}
    }
# endif /* TCL_THREADS */
#else
    (void)file;
    (void)line;
#endif /* TCL_MEM_DEBUG */
    ++(objPtr)->refCount;
}

/*
 *----------------------------------------------------------------------
 *
4030
4031
4032
4033
4034
4035
4036



4037
4038
4039
4040
4041
4042
4043
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072







+
+
+







	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "decr ref count");
	}
    }
# endif /* TCL_THREADS */
#else
    (void)file;
    (void)line;
#endif /* TCL_MEM_DEBUG */

    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}

4095
4096
4097
4098
4099
4100
4101



4102
4103
4104
4105
4106
4107
4108
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140







+
+
+







	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "check shared status");
	}
    }
# endif /* TCL_THREADS */
#else
    (void)file;
    (void)line;
#endif /* TCL_MEM_DEBUG */

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    if ((objPtr)->refCount <= 1) {
	tclObjsShared[1]++;
    } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
4158
4159
4160
4161
4162
4163
4164
4165

4166
4167
4168
4169



4170
4171
4172
4173
4174
4175
4176
4190
4191
4192
4193
4194
4195
4196

4197
4198
4199


4200
4201
4202
4203
4204
4205
4206
4207
4208
4209







-
+


-
-
+
+
+







 *	Increments the reference count on the object.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocObjEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    Tcl_HashTable *dummy,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_HashEntry *hPtr = ckalloc(sizeof(Tcl_HashEntry));
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr = (Tcl_HashEntry *)ckalloc(sizeof(Tcl_HashEntry));
    (void)dummy;

    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}
4193
4194
4195
4196
4197
4198
4199
4200

4201
4202
4203
4204
4205
4206
4207
4226
4227
4228
4229
4230
4231
4232

4233
4234
4235
4236
4237
4238
4239
4240







-
+







 */

int
TclCompareObjKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = keyPtr;
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
    const char *p1, *p2;
    size_t l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller
4279
4280
4281
4282
4283
4284
4285
4286

4287
4288
4289

4290
4291
4292


4293
4294
4295
4296
4297
4298
4299
4312
4313
4314
4315
4316
4317
4318

4319
4320
4321

4322
4323
4324

4325
4326
4327
4328
4329
4330
4331
4332
4333







-
+


-
+


-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_HASH_TYPE
TclHashObjKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    Tcl_HashTable *dummy,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    int length;
    const char *string = TclGetStringFromObj(objPtr, &length);
    unsigned int result = 0;
    TCL_HASH_TYPE result = 0;
    (void)dummy;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
4327
4328
4329
4330
4331
4332
4333
4334

4335
4336
4337
4338
4339
4340
4341
4361
4362
4363
4364
4365
4366
4367

4368
4369
4370
4371
4372
4373
4374
4375







-
+








    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	}
    }
    return (TCL_HASH_TYPE) result;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFromObj --
 *
4380
4381
4382
4383
4384
4385
4386
4387

4388
4389
4390
4391
4392
4393
4394
4414
4415
4416
4417
4418
4419
4420

4421
4422
4423
4424
4425
4426
4427
4428







-
+







     * Check also that the command's epoch is up to date, and that the command
     * is not deleted.
     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    if (objPtr->typePtr == &tclCmdNameType) {
        Command *cmdPtr = resPtr->cmdPtr;

        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
            Namespace *refNsPtr = (Namespace *)
4408
4409
4410
4411
4412
4413
4414
4415

4416
4417
4418
4419
4420
4421
4422
4442
4443
4444
4445
4446
4447
4448

4449
4450
4451
4452
4453
4454
4455
4456







-
+







     * had is invalid one way or another.
     */

    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
        return NULL;
    }
    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetCmdNameObj --
4446
4447
4448
4449
4450
4451
4452
4453

4454
4455
4456
4457
4458
4459
4460
4480
4481
4482
4483
4484
4485
4486

4487
4488
4489
4490
4491
4492
4493
4494







-
+







    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = ckalloc(sizeof(ResolvedCmdName));
	fillPtr = (ResolvedCmdName *)ckalloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;

4497
4498
4499
4500
4501
4502
4503
4504

4505
4506
4507
4508
4509
4510
4511
4531
4532
4533
4534
4535
4536
4537

4538
4539
4540
4541
4542
4543
4544
4545







-
+







				 * CmdName object. */
    Command *cmdPtr)		/* Points to Command structure that the
				 * CmdName object should refer to. */
{
    ResolvedCmdName *resPtr;

    if (objPtr->typePtr == &tclCmdNameType) {
	resPtr = objPtr->internalRep.twoPtrValue.ptr1;
	resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
	if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
	    return;
	}
    }

    SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
}
4532
4533
4534
4535
4536
4537
4538
4539

4540
4541
4542
4543
4544
4545
4546
4566
4567
4568
4569
4570
4571
4572

4573
4574
4575
4576
4577
4578
4579
4580







-
+







 */

static void
FreeCmdNameInternalRep(
    Tcl_Obj *objPtr)	/* CmdName object with internal
				 * representation to free. */
{
    ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;

	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
	 */

	if (resPtr->refCount-- <= 1) {
4579
4580
4581
4582
4583
4584
4585
4586

4587
4588
4589
4590
4591
4592
4593
4613
4614
4615
4616
4617
4618
4619

4620
4621
4622
4623
4624
4625
4626
4627







-
+







 */

static void
DupCmdNameInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    ResolvedCmdName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
	resPtr->refCount++;
    copyPtr->typePtr = &tclCmdNameType;
}

4642
4643
4644
4645
4646
4647
4648
4649

4650
4651
4652
4653
4654
4655
4656
4676
4677
4678
4679
4680
4681
4682

4683
4684
4685
4686
4687
4688
4689
4690







-
+







     * report the failure to find the command as an error.
     */

    if (cmdPtr == NULL) {
	return TCL_ERROR;
    }

    resPtr = objPtr->internalRep.twoPtrValue.ptr1;
    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
	/*
	 * Re-use existing ResolvedCmdName struct when possible.
	 * Cleanup the old fields that need it.
	 */

	Command *oldCmdPtr = resPtr->cmdPtr;
4680
4681
4682
4683
4684
4685
4686
4687

4688
4689
4690
4691
4692

4693
4694
4695
4696
4697
4698
4699
4714
4715
4716
4717
4718
4719
4720

4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RepresentationCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *descObj;
    (void)dummy;

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

    /*

Changes to generic/tclOptimize.c.

425
426
427
428
429
430
431
432
433
434



435
436
437
438
439
440
441
425
426
427
428
429
430
431



432
433
434
435
436
437
438
439
440
441







-
-
-
+
+
+







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

void
TclOptimizeBytecode(
    void *envPtr)
{
    ConvertZeroEffectToNOP(envPtr);
    AdvanceJumps(envPtr);
    TrimUnreachable(envPtr);
    ConvertZeroEffectToNOP((CompileEnv *)envPtr);
    AdvanceJumps((CompileEnv *)envPtr);
    TrimUnreachable((CompileEnv *)envPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78

Changes to generic/tclPanic.c.

47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61







-
+








void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
    if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL))
#elif defined(__CYGWIN__)
    if (proc == NULL)
	panicProc = tclWinDebugPanic;
    else
#endif
    panicProc = proc;
    Tcl_InitSubsystems();

Changes to generic/tclParse.c.

1139
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1139
1140
1141
1142
1143
1144
1145

1146
1147
1148
1149
1150
1151
1152
1153







-
+







	     * Command substitution. Call Tcl_ParseCommand recursively (and
	     * repeatedly) to parse the nested command(s), then throw away the
	     * parse information.
	     */

	    src++;
	    numBytes--;
	    nestedPtr = TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
	    nestedPtr = (Tcl_Parse *)TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
	    while (1) {
		const char *curEnd;

		if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
			nestedPtr) != TCL_OK) {
		    parsePtr->errorType = nestedPtr->errorType;
		    parsePtr->term = nestedPtr->term;
1527
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541
1527
1528
1529
1530
1531
1532
1533

1534
1535
1536
1537
1538
1539
1540
1541







-
+







				 * character must be "$". */
    const char **termPtr)	/* If non-NULL, points to word to fill in with
				 * character just after last one in the
				 * variable specifier. */
{
    Tcl_Obj *objPtr;
    int code;
    Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
	TclStackFree(interp, parsePtr);
	return NULL;
    }

    if (termPtr != NULL) {
2008
2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021
2022
2008
2009
2010
2011
2012
2013
2014

2015
2016
2017
2018
2019
2020
2021
2022







-
+







		 * within that substitution until we reach the actual parse
		 * error. We'll do additional parsing to determine what length
		 * to claim for the final TCL_TOKEN_COMMAND token.
		 */

		Tcl_Token *tokenPtr;
		const char *lastTerm = parsePtr->term;
		Tcl_Parse *nestedPtr =
		Tcl_Parse *nestedPtr = (Tcl_Parse *)
			TclStackAlloc(interp, sizeof(Tcl_Parse));

		while (TCL_OK ==
			Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
		    Tcl_FreeParse(nestedPtr);
		    p = nestedPtr->term + (nestedPtr->term < nestedPtr->end);
		    length = nestedPtr->end - p;
2150
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162
2163
2164
2150
2151
2152
2153
2154
2155
2156

2157
2158
2159
2160
2161
2162
2163
2164







-
+







	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = ckalloc(maxNumCL * sizeof(int));
	clPosition = (int *)ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;
2200
2201
2202
2203
2204
2205
2206
2207

2208
2209
2210
2211
2212
2213
2214
2200
2201
2202
2203
2204
2205
2206

2207
2208
2209
2210
2211
2212
2213
2214







-
+







			clPos = 0;
		    } else {
			TclGetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = ckrealloc(clPosition,
			clPosition = (int *)ckrealloc(clPosition,
				maxNumCL * sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }

Changes to generic/tclPathObj.c.

1269
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1269
1270
1271
1272
1273
1274
1275

1276
1277
1278
1279
1280
1281
1282
1283







-
+








	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    pathPtr = Tcl_NewObj();
    fsPathPtr = ckalloc(sizeof(FsPath));
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
1381
1382
1383
1384
1385
1386
1387
1388

1389
1390
1391
1392
1393
1394

1395
1396
1397
1398
1399
1400
1401
1381
1382
1383
1384
1385
1386
1387

1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402







-
+






+







 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclFSMakePathRelative(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Interp *dummy,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    int cwdLen, len;
    const char *tempStr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
    (void)dummy;

    if (irPtr) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
	    return fsPathPtr->normPathPtr;
	}
1452
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462

1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
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







-
+



+





-
+







 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
MakePathFromNormalized(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Interp *dummy,		/* Not used. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;
    (void)dummy;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
	return TCL_OK;
    }

    fsPathPtr = ckalloc(sizeof(FsPath));
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;

1529
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545







-
+








    /*
     * Free old representation; shouldn't normally be any, but best to be
     * safe.
     */

    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    fsPathPtr = ckalloc(sizeof(FsPath));
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;
1655
1656
1657
1658
1659
1660
1661
1662

1663
1664
1665
1666
1667
1668
1669
1657
1658
1659
1660
1661
1662
1663

1664
1665
1666
1667
1668
1669
1670
1671







-
+







    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	int len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = ckalloc(len+1);
	char *result = (char *)ckalloc(len+1);

	memcpy(result, orig, len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;
2010
2011
2012
2013
2014
2015
2016
2017

2018
2019
2020
2021
2022
2023
2024
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022
2023
2024
2025
2026







-
+







	char *nativePathPtr;

	proc = srcFsPathPtr->fsPtr->createInternalRepProc;
	if (proc == NULL) {
	    return NULL;
	}

	nativePathPtr = proc(pathPtr);
	nativePathPtr = (char *)proc(pathPtr);
	srcFsPathPtr = PATHOBJ(pathPtr);
	srcFsPathPtr->nativePathPtr = nativePathPtr;
	srcFsPathPtr->filesystemEpoch = TclFSEpoch();
    }

    return srcFsPathPtr->nativePathPtr;
}
2342
2343
2344
2345
2346
2347
2348
2349

2350
2351
2352
2353
2354
2355
2356
2344
2345
2346
2347
2348
2349
2350

2351
2352
2353
2354
2355
2356
2357
2358







-
+







    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = ckalloc(sizeof(FsPath));
    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    if (transPtr == pathPtr) {
        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
    }
2402
2403
2404
2405
2406
2407
2408
2409

2410
2411
2412
2413
2414
2415
2416
2404
2405
2406
2407
2408
2409
2410

2411
2412
2413
2414
2415
2416
2417
2418







-
+








static void
DupFsPathInternalRep(
    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));
    FsPath *copyFsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
    if (copyFsPathPtr->translatedPathPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
    }
2506
2507
2508
2509
2510
2511
2512
2513

2514

2515
2516
2517
2518
2519
2520
2521
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518
2519
2520
2521
2522
2523
2524







-
+

+







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

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    ClientData *clientDataPtr)
    ClientData *dummy)
{
    (void)dummy;
    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */

Changes to generic/tclPipe.c.

184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198







-
+







    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = ckalloc(sizeof(Detached));
	detPtr = (Detached *)ckalloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834
820
821
822
823
824
825
826

827
828
829
830
831
832
833
834







-
+








    /*
     * Scan through the argc array, creating a process for each group of
     * arguments between the "|" characters.
     */

    Tcl_ReapDetachedProcs();
    pidPtr = ckalloc(cmdCount * sizeof(Tcl_Pid));
    pidPtr = (Tcl_Pid *)ckalloc(cmdCount * sizeof(Tcl_Pid));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;

Changes to generic/tclPkg.c.

107
108
109
110
111
112
113
114

115
116
117
118
119
120
121
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121







-
+







static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = ckalloc(len), memcpy((v),(s),(len)))
    ((v) = (char *)ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	DupBlock((v),(s),local__len); \
    } while (0)

/*
222
223
224
225
226
227
228
229

230
231
232
233

234
235
236
237
238
239
240
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236
237
238
239
240
241







-
+




+







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

static void
PkgFilesCleanupProc(
    ClientData clientData,
    Tcl_Interp *interp)
    Tcl_Interp *dummy)
{
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;
    (void)dummy;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;

	pkgFiles->names = name->nextPtr;
	ckfree(name);
    }
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
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







-
+


-
+



















-
+







-
+







TclInitPkgFiles(
    Tcl_Interp *interp)
{
    /*
     * If assocdata "tclPkgFiles" doesn't exist yet, create it.
     */

    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (!pkgFiles) {
	pkgFiles = ckalloc(sizeof(PkgFiles));
	pkgFiles = (PkgFiles *)ckalloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}

void
TclPkgFileSeen(
    Tcl_Interp *interp,
    const char *fileName)
{
    PkgFiles *pkgFiles = (PkgFiles *)
	    Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (pkgFiles && pkgFiles->names) {
	const char *name = pkgFiles->names->name;
	Tcl_HashTable *table = &pkgFiles->table;
	int isNew;
	Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &isNew);
	Tcl_HashEntry *entry = (Tcl_HashEntry *)Tcl_CreateHashEntry(table, name, &isNew);
	Tcl_Obj *list;

	if (isNew) {
	    list = Tcl_NewObj();
	    Tcl_SetHashValue(entry, list);
	    Tcl_IncrRefCount(list);
	} else {
	    list = Tcl_GetHashValue(entry);
	    list = (Tcl_Obj *)Tcl_GetHashValue(entry);
	}
	Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1));
    }
}

#undef Tcl_PkgRequire
const char *
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
490
491
492
493
494
495
496
497

498
499

500

501
502
503
504
505
506
507
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
490
491
492
493
494
495
496
497
498

499
500

501
502
503
504
505
506
507
508
509
510







-
+













-
+

-
+


+




-
+






-
-
+
+


-
+












-
+

-
+

+







static int
TclNRPkgRequireProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[])
{
    RequireProcArgs *args = clientData;
    RequireProcArgs *args = (RequireProcArgs *)clientData;

    Tcl_NRAddCallback(interp,
	    PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv,
	    args->clientDataPtr);
    return TCL_OK;
}

static int
PkgRequireCore(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    const char *name = data[0];
    const char *name = (const char *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj *const *reqv = data[2];
    Tcl_Obj **reqv = (Tcl_Obj **)data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;
    (void)result;

    if (code != TCL_OK) {
	return code;
    }
    reqPtr = ckalloc(sizeof(Require));
    reqPtr = (Require *)ckalloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_NRAddCallback(interp,
		SelectPackage, reqPtr, INT2PTR(reqc), (void *) reqv,
		PkgRequireCoreStep1);
		SelectPackage, reqPtr, INT2PTR(reqc), reqv,
		(void *)PkgRequireCoreStep1);
    } else {
	Tcl_NRAddCallback(interp,
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *) reqv,NULL);
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep1(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_DString command;
    char *script;
    Require *reqPtr = data[0];
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name /* Name of desired package. */;
    (void)result;

    /*
     * If we've got the package in the DB already, go on to actually loading
     * it.
     */

    if (reqPtr->pkgPtr->version != NULL) {
547
548
549
550
551
552
553
554

555
556

557
558
559
560
561
562
563
550
551
552
553
554
555
556

557
558

559
560
561
562
563
564
565
566







-
+

-
+








static int
PkgRequireCoreStep2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = data[0];
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name; /* Name of desired package. */

    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	result = TCL_ERROR;
571
572
573
574
575
576
577
578
579


580
581
582
583
584
585
586
587
588
589

590
591

592
593
594

595
596
597
598
599
600
601
574
575
576
577
578
579
580


581
582
583
584
585
586
587
588
589
590
591

592
593

594
595
596
597
598
599
600
601
602
603
604
605







-
-
+
+









-
+

-
+



+








    /*
     * pkgPtr may now be invalid, so refresh it.
     */

    reqPtr->pkgPtr = FindPackage(interp, name);
    Tcl_NRAddCallback(interp,
	    SelectPackage, reqPtr, INT2PTR(reqc), (void *) reqv,
	    PkgRequireCoreFinal);
	    SelectPackage, reqPtr, INT2PTR(reqc), reqv,
	    (void *)PkgRequireCoreFinal);
    return TCL_OK;
}

static int
PkgRequireCoreFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = data[0];
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]), satisfies;
    Tcl_Obj **const reqv = data[2];
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    char *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name; /* Name of desired package. */
    (void)result;

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't find package %s", name));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
	AddRequirementsToResult(interp, reqc, reqv);
	return TCL_ERROR;
631
632
633
634
635
636
637
638

639
640


641
642
643
644
645
646
647
648
649
650
651
652
653
654
655

656
657

658
659
660

661
662
663
664
665
666
667
635
636
637
638
639
640
641

642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660

661
662

663
664
665
666
667
668
669
670
671
672
673
674







-
+


+
+














-
+

-
+



+







    Tcl_SetObjResult(interp, reqPtr->pkgPtr->version);
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    (void)dummy;

    ckfree(data[0]);
    return result;
}

static int
SelectPackage(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = data[0];
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;
    (void)result;

    /*
     * Check whether we're already attempting to load some version of this
     * package (circular dependency detection).
     */

    if (pkgPtr->clientData != NULL) {
802
803
804
805
806
807
808
809

810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825

826
827
828
829
830
831

832
833
834
835
836
837
838
809
810
811
812
813
814
815

816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831

832
833
834
835
836
837

838
839
840
841
842
843
844
845







-
+















-
+





-
+







    if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
	    && (bestStablePtr != NULL)) {
	bestPtr = bestStablePtr;
    }

    if (bestPtr == NULL) {
	Tcl_NRAddCallback(interp,
		data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
		(Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    } else {
	/*
	 * We found an ifneeded script for the package. Be careful while
	 * executing it: this could cause reentrancy, so (a) protect the
	 * script itself from deletion and (b) don't assume that bestPtr will
	 * still exist when the script completes.
	 */

	char *versionToProvide = bestPtr->version;
	PkgFiles *pkgFiles;
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = TclInitPkgFiles(interp);
	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	 */

	pkgName = ckalloc(sizeof(PkgName) + strlen(name));
	pkgName = (PkgName *)ckalloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;
847
848
849
850
851
852
853
854

855
856

857
858
859
860
861
862
863
864

865
866
867
868
869
870
871
854
855
856
857
858
859
860

861
862

863
864
865
866
867
868
869
870

871
872
873
874
875
876
877
878







-
+

-
+







-
+








static int
SelectPackageFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Require *reqPtr = data[0];
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */

    PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    ckfree(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
939
940
941
942
943
944
945
946

947
948
949
950
951
952
953
946
947
948
949
950
951
952

953
954
955
956
957
958
959
960







-
+







	    reqPtr->pkgPtr->version = NULL;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
    }

    Tcl_NRAddCallback(interp,
	    data[3], reqPtr, INT2PTR(reqc), (void *) reqv, NULL);
	    (Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *) reqv, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgPresent / Tcl_PkgPresentEx --
1000
1001
1002
1003
1004
1005
1006
1007

1008
1009
1010
1011
1012
1013
1014
1007
1008
1009
1010
1011
1012
1013

1014
1015
1016
1017
1018
1019
1020
1021







-
+







{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Package *pkgPtr;

    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
    if (hPtr) {
	pkgPtr = Tcl_GetHashValue(hPtr);
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    /*
	     * At this point we know that the package is present. Make sure
	     * that the provided version meets the current requirement by
	     * calling Tcl_PkgRequireEx() to check for us.
	     */

1053
1054
1055
1056
1057
1058
1059


1060
1061
1062
1063
1064
1065
1066
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075







+
+







int
Tcl_PackageObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, NULL, objc, objv);
}

	/* ARGSUSED */
int
TclNRPackageObjCmd(
    ClientData dummy,		/* Not used. */
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108







+







    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *tablePtr;
    const char *version;
    const char *argv2, *argv3, *argv4;
    char *iva = NULL, *ivb = NULL;
    Tcl_Obj *objvListPtr, **newObjvPtr;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
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
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







-
+









-
+







		Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

	for (i = 2; i < objc; i++) {
	    keyString = TclGetString(objv[i]);
	    if (pkgFiles) {
		hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
		if (hPtr) {
		    Tcl_Obj *obj = Tcl_GetHashValue(hPtr);
		    Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		    Tcl_DeleteHashEntry(hPtr);
		    Tcl_DecrRefCount(obj);
		}
	    }

	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
	    if (hPtr == NULL) {
		continue;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		Tcl_DecrRefCount(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
1172
1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1182
1183
1184
1185
1186
1187
1188

1189
1190
1191
1192
1193
1194
1195
1196







-
+







	argv2 = TclGetString(objv[2]);
	if (objc == 4) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr == NULL) {
		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
1210
1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223
1224
1220
1221
1222
1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1234







-
+







	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = ckalloc(sizeof(PkgAvail));
	    availPtr = (PkgAvail *)ckalloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
1241
1242
1243
1244
1245
1246
1247
1248

1249
1250
1251

1252
1253
1254
1255
1256
1257
1258
1251
1252
1253
1254
1255
1256
1257

1258
1259
1260

1261
1262
1263
1264
1265
1266
1267
1268







-
+


-
+







	} else {
	    Tcl_Obj *resultObj;

	    resultObj = Tcl_NewObj();
	    tablePtr = &iPtr->packageTable;
	    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
		    hPtr = Tcl_NextHashEntry(&search)) {
		pkgPtr = Tcl_GetHashValue(hPtr);
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
		    Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
			    Tcl_GetHashKey(tablePtr, hPtr), -1));
			    (char *)Tcl_GetHashKey(tablePtr, hPtr), -1));
		}
	    }
	    Tcl_SetObjResult(interp, resultObj);
	}
	break;
    case PKG_PRESENT: {
	const char *name;
1270
1271
1272
1273
1274
1275
1276
1277

1278
1279
1280
1281
1282
1283
1284
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291
1292
1293
1294







-
+







	} else {
	    exact = 0;
	    name = argv2;
	}

	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
	if (hPtr != NULL) {
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	    if (pkgPtr->version != NULL) {
		goto require;
	    }
	}

	version = NULL;
	if (exact) {
1305
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1329







-
+







	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;
	}
	argv2 = TclGetString(objv[2]);
	if (objc == 3) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr != NULL) {
		pkgPtr = Tcl_GetHashValue(hPtr);
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		if (pkgPtr->version != NULL) {
		    Tcl_SetObjResult(interp, pkgPtr->version);
		}
	    }
	    return TCL_OK;
	}
	argv3 = TclGetString(objv[3]);
1491
1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
1515







-
+







	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj = Tcl_NewObj();

	    argv2 = TclGetString(objv[2]);
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr != NULL) {
		pkgPtr = Tcl_GetHashValue(hPtr);
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		for (availPtr = pkgPtr->availPtr; availPtr != NULL;
			availPtr = availPtr->nextPtr) {
		    Tcl_ListObjAppendElement(NULL, resultObj,
			    Tcl_NewStringObj(availPtr->version, -1));
		}
	    }
	    Tcl_SetObjResult(interp, resultObj);
1532
1533
1534
1535
1536
1537
1538
1539

1540
1541


1542
1543
1544
1545
1546
1547
1548
1542
1543
1544
1545
1546
1547
1548

1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560







-
+


+
+







    }
    return TCL_OK;
}

static int
TclNRPackageObjCmdCleanup(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    int result)
{
    (void)dummy;

    TclDecrRefCount((Tcl_Obj *) data[0]);
    TclDecrRefCount((Tcl_Obj *) data[1]);
    return result;
}

/*
 *----------------------------------------------------------------------
1570
1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583

1584
1585
1586
1587
1588
1589
1590
1582
1583
1584
1585
1586
1587
1588

1589
1590
1591
1592
1593
1594

1595
1596
1597
1598
1599
1600
1601
1602







-
+





-
+







    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
    Package *pkgPtr;

    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
    if (isNew) {
	pkgPtr = ckalloc(sizeof(Package));
	pkgPtr = (Package *)ckalloc(sizeof(Package));
	pkgPtr->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = Tcl_GetHashValue(hPtr);
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
    }
    return pkgPtr;
}

/*
 *----------------------------------------------------------------------
 *
1609
1610
1611
1612
1613
1614
1615
1616

1617
1618
1619
1620
1621
1622
1623
1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1635







-
+







    Package *pkgPtr;
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    PkgAvail *availPtr;

    for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	pkgPtr = Tcl_GetHashValue(hPtr);
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    Tcl_DecrRefCount(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
1668
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679
1680
1681
1682
1680
1681
1682
1683
1684
1685
1686

1687
1688
1689
1690
1691
1692
1693
1694







-
+







    const char *p = string;
    char prevChar;
    int hasunstable = 0;
    /*
     * 4* assuming that each char is a separator (a,b become ' -x ').
     * 4+ to have spce for an additional -2 at the end
     */
    char *ibuf = ckalloc(4 + 4*strlen(string));
    char *ibuf = (char *)ckalloc(4 + 4*strlen(string));
    char *ip = ibuf;

    /*
     * Basic rules
     * (1) First character has to be a digit.
     * (2) All other characters have to be a digit or '.'
     * (3) Two '.'s may not follow each other.
1995
1996
1997
1998
1999
2000
2001
2002

2003
2004
2005
2006
2007
2008
2009
2007
2008
2009
2010
2011
2012
2013

2014
2015
2016
2017
2018
2019
2020
2021







-
+







     * Syntax of requirement = version
     *			     = version-version
     *			     = version-
     */

    char *dash = NULL, *buf;

    dash = strchr(string, '-');
    dash = (char *)strchr(string, '-');
    if (dash == NULL) {
	/*
	 * No dash found, has to be a simple version.
	 */

	return CheckVersionAndConvert(interp, string, NULL, NULL);
    }
2183
2184
2185
2186
2187
2188
2189
2190

2191
2192
2193
2194
2195
2196
2197
2195
2196
2197
2198
2199
2200
2201

2202
2203
2204
2205
2206
2207
2208
2209







-
+







    /*
     * The have candidate is already in internal rep.
     */

    int satisfied, res;
    char *dash = NULL, *buf, *min, *max;

    dash = strchr(req, '-');
    dash = (char *)strchr(req, '-');
    if (dash == NULL) {
	/*
	 * No dash found, is a simple version, fallback to regular check. The
	 * 'CheckVersionAndConvert' cannot fail. We pad the requirement with
	 * 'a0', i.e '-2' before doing the comparison to properly accept
	 * unstables as well.
	 */

Changes to generic/tclPreserve.c.

140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154







-
+







    /*
     * Make a reference array if it doesn't already exist, or make it bigger
     * if it is full.
     */

    if (inUse == spaceAvl) {
	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
	refArray = ckrealloc(refArray, spaceAvl * sizeof(Reference));
	refArray = (Reference *)ckrealloc(refArray, spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];
222
223
224
225
226
227
228
229

230
231
232
233
234
235
236
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+







	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		ckfree(clientData);
	    } else {
		freeProc(clientData);
		freeProc((char *)clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);

    /*
289
290
291
292
293
294
295
296

297
298
299
300
301
302
303
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303







-
+







    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	ckfree(clientData);
    } else {
	freeProc(clientData);
	freeProc((char *)clientData);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandleCreate --
323
324
325
326
327
328
329
330

331
332
333
334
335
336
337
323
324
325
326
327
328
329

330
331
332
333
334
335
336
337







-
+








TclHandle
TclHandleCreate(
    void *ptr)			/* Pointer to an arbitrary block of memory to
				 * be tracked for deletion. Must not be
				 * NULL. */
{
    HandleStruct *handlePtr = ckalloc(sizeof(HandleStruct));
    HandleStruct *handlePtr = (HandleStruct *)ckalloc(sizeof(HandleStruct));

    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;

Changes to generic/tclProc.c.

77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91







-
+







	Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir);		\
    } while (0)

#define ProcGetIntRep(objPtr, procPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclProcBodyType);		\
	(procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The [upvar]/[uplevel] level reference type. Uses the longValue field
 * to remember the integer value of a parsed #<integer> format.
 *
 * Uses the default behaviour throughout, and never disposes of the string
123
124
125
126
127
128
129
130
131


132
133
134
135
136
137
138
123
124
125
126
127
128
129


130
131
132
133
134
135
136
137
138







-
-
+
+







	Tcl_StoreIntRep((objPtr), &lambdaType, &ir);			\
    } while (0)

#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &lambdaType);			\
	(procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL;		\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_ProcObjCmd --
159
160
161
162
163
164
165

166
167
168
169
170
171
172
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173







+







{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
    const char *procName;
    const char *simpleName, *procArgs, *procBody;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_Command cmd;
    (void)dummy;

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

    /*
228
229
230
231
232
233
234
235

236
237
238
239
240
241
242
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243







-
+







     * this file. The differences are the different index of the body in the
     * line array of the context, and the lambda code requires some special
     * processing. Find a way to factor the common elements into a single
     * function.
     */

    if (iPtr->cmdFramePtr) {
	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));

	*contextPtr = *iPtr->cmdFramePtr;
	if (contextPtr->type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve source information from the bytecode, if possible. If
	     * the information is retrieved successfully, context.type will be
	     * TCL_LOCATION_SOURCE and the reference held by
259
260
261
262
263
264
265
266

267
268
269
270

271
272
273
274
275
276
277
260
261
262
263
264
265
266

267
268
269
270

271
272
273
274
275
276
277
278







-
+



-
+







	     * proc body was not created by substitution.
	     */

	    if (contextPtr->line
		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
		int isNew;
		Tcl_HashEntry *hePtr;
		CmdFrame *cfPtr = ckalloc(sizeof(CmdFrame));
		CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line = (int *)ckalloc(sizeof(int));
		cfPtr->line[0] = contextPtr->line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
286
287
288
289
290
291
292

293
294
295
296
297
298
299
300







-
+







		    /*
		     * Get the old command frame and release it. See also
		     * TclProcCleanupProc in this file. Currently it seems as
		     * if only the procbodytest::proc command of the testsuite
		     * is able to trigger this situation.
		     */

		    CmdFrame *cfOldPtr = Tcl_GetHashValue(hePtr);
		    CmdFrame *cfOldPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);

		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
			cfOldPtr->data.eval.path = NULL;
		    }
		    ckfree(cfOldPtr->line);
		    cfOldPtr->line = NULL;
406
407
408
409
410
411
412

413
414
415
416
417
418
419
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421







+







    Interp *iPtr = (Interp *) interp;

    Proc *procPtr = NULL;
    int i, result, numArgs;
    CompiledLocal *localPtr = NULL;
    Tcl_Obj **argArray;
    int precompiled = 0;
    (void)nsPtr;

    ProcGetIntRep(bodyPtr, procPtr);
    if (procPtr != NULL) {
	/*
	 * Because the body is a TclProProcBody, the actual body is already
	 * compiled, and it is not shared with anyone else, so it's OK not to
	 * unshare it (as a matter of fact, it is bad to unshare it, because
465
466
467
468
469
470
471
472

473
474
475
476
477
478
479
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481







-
+







	 * Create and initialize a Proc structure for the procedure. We
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
	 */

	Tcl_IncrRefCount(bodyPtr);

	procPtr = ckalloc(sizeof(Proc));
	procPtr = (Proc *)ckalloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */
	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;
630
631
632
633
634
635
636
637

638
639
640
641
642
643
644
632
633
634
635
636
637
638

639
640
641
642
643
644
645
646







-
+







	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1);
	    localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1);
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
866
867
868
869
870
871
872
873

874
875
876
877
878
879
880
868
869
870
871
872
873
874

875
876
877
878
879
880
881
882







-
+








static int
Uplevel_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallFrame *savedVarFramePtr = data[0];
    CallFrame *savedVarFramePtr = (CallFrame *)data[0];

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
    }

    /*
906
907
908
909
910
911
912

913
914
915
916
917
918
919
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922







+








    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
    int word = 0;
    int result;
    CallFrame *savedVarFramePtr, *framePtr;
    Tcl_Obj *objPtr;
    (void)dummy;

    if (objc < 2) {
    uplevelSyntax:
	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
	return TCL_ERROR;
    }

1029
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058


1059
1060
1061
1062
1063
1064
1065
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059


1060
1061
1062
1063
1064
1065
1066
1067
1068







-
+




















-
-
+
+







{
    Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);

    if (origCmd != NULL) {
	cmdPtr = (Command *) origCmd;
    }
    if (cmdPtr->deleteProc == TclProcDeleteProc) {
	return cmdPtr->objClientData;
	return (Proc *)cmdPtr->objClientData;
    }
    return NULL;
}

static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));
    desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
	    sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = framePtr->objv[skip-1];
#else
1312
1313
1314
1315
1316
1317
1318
1319

1320
1321
1322
1323
1324
1325
1326
1315
1316
1317
1318
1319
1320
1321

1322
1323
1324
1325
1326
1327
1328
1329







-
+








    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.
     */

    localCachePtr = ckalloc(sizeof(LocalCache)
    localCachePtr = (LocalCache *)ckalloc(sizeof(LocalCache)
	    + (localCt - 1) * sizeof(Tcl_Obj *)
	    + numArgs * sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394







+







{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;
    (void)procNameObj;

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
     */
1402
1403
1404
1405
1406
1407
1408
1409

1410
1411
1412
1413
1414
1415
1416
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419
1420







-
+








    /*
     * Create the "compiledLocals" array. Make sure it is large enough to hold
     * all the procedure's compiled local variables, including its formal
     * parameters.
     */

    varPtr = TclStackAlloc(interp, (int)(localCt * sizeof(Var)));
    varPtr = (Var *)TclStackAlloc(interp, localCt * sizeof(Var));
    framePtr->compiledLocals = varPtr;
    framePtr->numCompiledLocals = localCt;

    /*
     * Match and assign the call's actual parameters to the procedure's formal
     * arguments. The formal arguments are described by the first numArgs
     * entries in both the Proc structure's local variable list and the call
1540
1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552
1553
1554
1544
1545
1546
1547
1548
1549
1550

1551
1552
1553
1554
1555
1556
1557
1558







-
+







				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[],	/* Argument value objects. */
    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
				 * needs special rules for error msg */
{
    Proc *procPtr = clientData;
    Proc *procPtr = (Proc *)clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame *framePtr, **framePtrPtr;
    int result;
    ByteCode *codePtr;

    /*
     * If necessary (i.e. if we haven't got a suitable compilation already
1780
1781
1782
1783
1784
1785
1786
1787

1788
1789
1790
1791
1792
1793
1794
1784
1785
1786
1787
1788
1789
1790

1791
1792
1793
1794
1795
1796
1797
1798







-
+







    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = iPtr->varFramePtr->procPtr;
    CallFrame *freePtr;
    Tcl_Obj *procNameObj = data[0];
    Tcl_Obj *procNameObj = (Tcl_Obj *)data[0];
    ProcErrorProc *errorProc = (ProcErrorProc *)data[1];

    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
1957
1958
1959
1960
1961
1962
1963



1964
1965
1966
1967
1968
1969
1970
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977







+
+
+







	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
#else
    (void)description;
    (void)procName;
#endif

	/*
	 * Plug the current procPtr into the interpreter and coerce the code
	 * body to byte codes. The interpreter needs to know which proc it's
	 * compiling so that it can access its list of compiled locals.
	 *
2018
2019
2020
2021
2022
2023
2024
2025

2026
2027
2028
2029
2030
2031
2032
2025
2026
2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037
2038
2039







-
+







	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);

	/*
	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
	 */

	iPtr->invokeWord = 0;
	iPtr->invokeCmdFramePtr = (hePtr ? Tcl_GetHashValue(hePtr) : NULL);
	iPtr->invokeCmdFramePtr = hePtr ? (CmdFrame *)Tcl_GetHashValue(hePtr) : NULL;
	TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
	iPtr->invokeCmdFramePtr = NULL;
	TclPopStackFrame(interp);
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	/*
	 * The resolver epoch has changed, but we only need to invalidate the
	 * resolver cache.
2093
2094
2095
2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
2100
2101
2102
2103
2104
2105
2106

2107
2108
2109
2110
2111
2112
2113
2114







-
+







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

void
TclProcDeleteProc(
    ClientData clientData)	/* Procedure to be deleted. */
{
    Proc *procPtr = clientData;
    Proc *procPtr = (Proc *)clientData;

    if (procPtr->refCount-- <= 1) {
	TclProcCleanupProc(procPtr);
    }
}

/*
2168
2169
2170
2171
2172
2173
2174
2175

2176
2177
2178
2179
2180
2181
2182
2175
2176
2177
2178
2179
2180
2181

2182
2183
2184
2185
2186
2187
2188
2189







-
+







    }

    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
    if (!hePtr) {
	return;
    }

    cfPtr = Tcl_GetHashValue(hePtr);
    cfPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);

    if (cfPtr) {
	if (cfPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(cfPtr->data.eval.path);
	    cfPtr->data.eval.path = NULL;
	}
	ckfree(cfPtr->line);
2475
2476
2477
2478
2479
2480
2481
2482

2483
2484
2485
2486
2487
2488
2489
2482
2483
2484
2485
2486
2487
2488

2489
2490
2491
2492
2493
2494
2495
2496







-
+







     * this file. The differences are the different index of the body in the
     * line array of the context, and the special processing mentioned in the
     * previous paragraph to track into the list. Find a way to factor the
     * common elements into a single function.
     */

    if (iPtr->cmdFramePtr) {
	CmdFrame *contextPtr = TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));

	*contextPtr = *iPtr->cmdFramePtr;
	if (contextPtr->type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve the source context from the bytecode. This call
	     * accounts for the reference to the source file, if any, held in
	     * 'context.data.eval.path'.
2511
2512
2513
2514
2515
2516
2517
2518

2519
2520
2521
2522
2523

2524
2525
2526
2527
2528
2529
2530
2518
2519
2520
2521
2522
2523
2524

2525
2526
2527
2528
2529

2530
2531
2532
2533
2534
2535
2536
2537







-
+




-
+







		int buf[2];

		/*
		 * Move from approximation (line of list cmd word) to actual
		 * location (line of 2nd list element).
		 */

		cfPtr = ckalloc(sizeof(CmdFrame));
		cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = ckalloc(sizeof(int));
		cfPtr->line = (int *)ckalloc(sizeof(int));
		cfPtr->line[0] = buf[1];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);
2635
2636
2637
2638
2639
2640
2641

2642
2643
2644
2645
2646
2647
2648
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Proc *procPtr = NULL;
    Tcl_Obj *lambdaPtr, *nsObjPtr;
    int result;
    Tcl_Namespace *nsPtr;
    ApplyExtraData *extraPtr;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
	return TCL_ERROR;
    }

    /*
2663
2664
2665
2666
2667
2668
2669
2670

2671
2672
2673
2674
2675
2676
2677
2671
2672
2673
2674
2675
2676
2677

2678
2679
2680
2681
2682
2683
2684
2685







-
+







     */

    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    extraPtr = TclStackAlloc(interp, sizeof(ApplyExtraData));
    extraPtr = (ApplyExtraData *)TclStackAlloc(interp, sizeof(ApplyExtraData));
    memset(&extraPtr->cmd, 0, sizeof(Command));
    procPtr->cmdPtr = &extraPtr->cmd;
    extraPtr->cmd.nsPtr = (Namespace *) nsPtr;

    /*
     * TIP#280 (semi-)HACK!
     *
2698
2699
2700
2701
2702
2703
2704
2705

2706
2707
2708
2709
2710
2711
2712
2706
2707
2708
2709
2710
2711
2712

2713
2714
2715
2716
2717
2718
2719
2720







-
+








static int
ApplyNR2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ApplyExtraData *extraPtr = data[0];
    ApplyExtraData *extraPtr = (ApplyExtraData *)data[0];

    TclStackFree(interp, extraPtr);
    return result;
}

/*
 *----------------------------------------------------------------------

Changes to generic/tclProcess.c.

398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413

414
415
416
417
418
419
420
398
399
400
401
402
403
404

405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421







-
+








+







 *	Access to the internal structures is protected by infoTablesMutex.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessListObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *list;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    (void)dummy;

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

    /*
449
450
451
452
453
454
455
456

457
458
459
460
461
462
463
450
451
452
453
454
455
456

457
458
459
460
461
462
463
464







-
+







 *	Calls RefreshProcessInfo, which can block if -wait switch is given.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessStatusObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dict;
    int index, options = WNOHANG;
    Tcl_HashEntry *entry;
471
472
473
474
475
476
477

478
479
480
481
482
483
484
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486







+







    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };
    enum switches {
	STATUS_WAIT, STATUS_LAST
    };
    (void)dummy;

    while (objc > 1) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0,
		&index) != TCL_OK) {
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
612
613
614
615
616

617
618
619
620
621
622
623
599
600
601
602
603
604
605

606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626







-
+












+







 *	Frees all ProcessInfo structures with their purge flag set.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessPurgeObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    int numPids;
    Tcl_Obj **pidObjs;
    int result;
    int i;
    int pid;
    (void)dummy;

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

    /*
697
698
699
700
701
702
703
704

705
706
707
708


709
710
711
712
713
714
715
700
701
702
703
704
705
706

707
708
709
710
711
712
713
714
715
716
717
718
719
720







-
+




+
+







 *	Alters detached process handling by Tcl_ReapDetachedProcs().
 *
 *----------------------------------------------------------------------
 */

static int
ProcessAutopurgeObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

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

    if (objc == 2) {
	/*

Changes to generic/tclRegexp.c.

118
119
120
121
122
123
124
125

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

125
126
127
128
129
130
131
132







-
+







	Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir);			\
    } while (0)

#define RegexpGetIntRep(objPtr, rePtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclRegexpType);		\
	(rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegExpCompile --
912
913
914
915
916
917
918
919

920
921
922
923
924
925
926
912
913
914
915
916
917
918

919
920
921
922
923
924
925
926







-
+







	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    regexpPtr = ckalloc(sizeof(TclRegexp));
    regexpPtr = (TclRegexp*)ckalloc(sizeof(TclRegexp));
    regexpPtr->objPtr = NULL;
    regexpPtr->string = NULL;
    regexpPtr->details.rm_extend.rm_so = -1;
    regexpPtr->details.rm_extend.rm_eo = -1;

    /*
     * Get the up-to-date string representation and map to unicode.
967
968
969
970
971
972
973
974

975
976
977
978
979
980
981
967
968
969
970
971
972
973

974
975
976
977
978
979
980
981







-
+








    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.
     */

    regexpPtr->matches =
	    ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
	    (regmatch_t*)ckalloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));

    /*
     * Initialize the refcount to one initially, since it is in the cache.
     */

    regexpPtr->refCount = 1;

993
994
995
996
997
998
999
1000

1001
1002
1003
1004
1005
1006
1007
993
994
995
996
997
998
999

1000
1001
1002
1003
1004
1005
1006
1007







-
+







	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
    }
    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
    }
    tsdPtr->patterns[0] = ckalloc(length + 1);
    tsdPtr->patterns[0] = (char *)ckalloc(length + 1);
    memcpy(tsdPtr->patterns[0], string, length + 1);
    tsdPtr->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}

1049
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1049
1050
1051
1052
1053
1054
1055

1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068







-
+




+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeRegexp(
    ClientData clientData)	/* Not used. */
    ClientData dummy)	/* Not used. */
{
    int i;
    TclRegexp *regexpPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	regexpPtr = tsdPtr->regexps[i];
	if (regexpPtr->refCount-- <= 1) {
	    FreeRegexp(regexpPtr);
	}
	ckfree(tsdPtr->patterns[i]);

Changes to generic/tclResolve.c.

97
98
99
100
101
102
103
104

105
106

107
108
109
110
111
112
113
97
98
99
100
101
102
103

104
105

106
107
108
109
110
111
112
113







-
+

-
+







    }

    /*
     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
     * list, so that it overrides existing schemes.
     */

    resPtr = ckalloc(sizeof(ResolverScheme));
    resPtr = (ResolverScheme *)ckalloc(sizeof(ResolverScheme));
    len = strlen(name) + 1;
    resPtr->name = ckalloc(len);
    resPtr->name = (char *)ckalloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}
261
262
263
264
265
266
267
268

269
270
271
272
273
274
275
261
262
263
264
265
266
267

268
269
270
271
272
273
274
275







-
+







    Tcl_HashSearch search;

    nsPtr->cmdRefEpoch++;

#ifndef BREAK_NAMESPACE_COMPAT
    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	Namespace *childNsPtr = Tcl_GetHashValue(entry);
	Namespace *childNsPtr = (Namespace *)Tcl_GetHashValue(entry);

	BumpCmdRefEpochs(childNsPtr);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {

Changes to generic/tclResult.c.

73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
73
74
75
76
77
78
79

80
81
82
83
84
85
86
87







-
+








Tcl_InterpState
Tcl_SaveInterpState(
    Tcl_Interp *interp,		/* Interpreter's state to be saved */
    int status)			/* status code for current operation */
{
    Interp *iPtr = (Interp *) interp;
    InterpState *statePtr = ckalloc(sizeof(InterpState));
    InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));

    statePtr->status = status;
    statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
    statePtr->returnLevel = iPtr->returnLevel;
    statePtr->returnCode = iPtr->returnCode;
    statePtr->errorInfo = iPtr->errorInfo;
    statePtr->errorStack = iPtr->errorStack;
428
429
430
431
432
433
434
435

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

435
436
437
438
439
440
441
442







-
+







	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;
	iPtr->freeProc = 0;
    } else if (freeProc == TCL_VOLATILE) {
	int length = strlen(result);

	if (length > TCL_RESULT_SIZE) {
	    iPtr->result = ckalloc(length + 1);
	    iPtr->result = (char *)ckalloc(length + 1);
	    iPtr->freeProc = TCL_DYNAMIC;
	} else {
	    iPtr->result = iPtr->resultSpace;
	    iPtr->freeProc = 0;
	}
	memcpy(iPtr->result, result, length+1);
    } else {
835
836
837
838
839
840
841
842

843
844
845
846
847
848
849
835
836
837
838
839
840
841

842
843
844
845
846
847
848
849







-
+







	char *newSpace;

	if (totalSpace < 100) {
	    totalSpace = 200;
	} else {
	    totalSpace *= 2;
	}
	newSpace = ckalloc(totalSpace);
	newSpace = (char *)ckalloc(totalSpace);
	strcpy(newSpace, iPtr->result);
	if (iPtr->appendResult != NULL) {
	    ckfree(iPtr->appendResult);
	}
	iPtr->appendResult = newSpace;
	iPtr->appendAvl = totalSpace;
    } else if (iPtr->result != iPtr->appendResult) {
1170
1171
1172
1173
1174
1175
1176
1177
1178


1179
1180
1181
1182
1183
1184
1185
1170
1171
1172
1173
1174
1175
1176


1177
1178
1179
1180
1181
1182
1183
1184
1185







-
-
+
+







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

static Tcl_Obj **
GetKeys(void)
{
    static Tcl_ThreadDataKey returnKeysKey;
    Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey,
	    (int) (KEY_LAST * sizeof(Tcl_Obj *)));
    Tcl_Obj **keys = (Tcl_Obj **)Tcl_GetThreadData(&returnKeysKey,
	    KEY_LAST * sizeof(Tcl_Obj *));

    if (keys[0] == NULL) {
	/*
	 * First call in this thread, create the keys...
	 */

	int i;
1222
1223
1224
1225
1226
1227
1228
1229

1230
1231
1232
1233
1234
1235
1236
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1236







-
+







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

static void
ReleaseKeys(
    ClientData clientData)
{
    Tcl_Obj **keys = clientData;
    Tcl_Obj **keys = (Tcl_Obj **)clientData;
    int i;

    for (i = KEY_CODE; i < KEY_LAST; i++) {
	Tcl_DecrRefCount(keys[i]);
	keys[i] = NULL;
    }
}

Changes to generic/tclScan.c.

24
25
26
27
28
29
30





31
32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
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







+
+
+
+
+






-
-
-
-
+







#define SCAN_LONGER	0x400		/* Asked for a wide value. */
#define SCAN_BIG	0x800		/* Asked for a bignum value. */

/*
 * The following structure contains the information associated with a
 * character set.
 */

typedef struct {
    Tcl_UniChar start;
    Tcl_UniChar end;
} Range;

typedef struct CharSet {
    int exclude;		/* 1 if this is an exclusion set. */
    int nchars;
    Tcl_UniChar *chars;
    int nranges;
    struct Range {
	Tcl_UniChar start;
	Tcl_UniChar end;
    } *ranges;
    Range *ranges;
} CharSet;

/*
 * Declarations for functions used only in this file.
 */

static const char *	BuildCharSet(CharSet *cset, const char *format);
98
99
100
101
102
103
104
105

106
107

108
109
110
111
112
113
114
100
101
102
103
104
105
106

107
108

109
110
111
112
113
114
115
116







-
+

-
+







    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
    }

    cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
    cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = ckalloc(sizeof(struct Range) * nranges);
	cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */
256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
258
259
260
261
262
263
264

265
266
267
268
269
270
271
272







-
+







    int *totalSubs)		/* The number of variables that will be
				 * required. */
{
    int gotXpg, gotSequential, value, i, flags;
    char *end;
    Tcl_UniChar ch = 0;
    int objIndex, xpgSize, nspace = numVars;
    int *nassign = TclStackAlloc(interp, nspace * sizeof(int));
    int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
				 * these are messy operations because we do
				 * not want to use the formatting engine;
				 * we're inside there! */
    char buf[5] = "";

    /*
473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
475
476
477
478
479
480
481

482
483
484
485
486
487
488
489







-
+








		value = nspace;
		if (xpgSize) {
		    nspace = xpgSize;
		} else {
		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
		}
		nassign = TclStackRealloc(interp, nassign,
		nassign = (int *)TclStackRealloc(interp, nassign,
			nspace * sizeof(int));
		for (i = value; i < nspace; i++) {
		    nassign[i] = 0;
		}
	    }
	    nassign[objIndex]++;
	    objIndex++;
575
576
577
578
579
580
581

582
583
584
585
586
587
588
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591







+







    const char *string, *end, *baseString;
    char op = 0;
    int width, underflow = 0;
    Tcl_WideInt wideValue;
    Tcl_UniChar ch = 0, sch = 0;
    Tcl_Obj **objs = NULL, *objPtr = NULL;
    int flags;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string format ?varName ...?");
	return TCL_ERROR;
    }

598
599
600
601
602
603
604
605

606
607
608
609
610
611
612
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615







-
+







    }

    /*
     * Allocate space for the result objects.
     */

    if (totalVars > 0) {
	objs = ckalloc(sizeof(Tcl_Obj *) * totalVars);
	objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = Tcl_GetString(objv[1]);
    baseString = string;

Changes to generic/tclStrToD.c.

2332
2333
2334
2335
2336
2337
2338
2339

2340
2341
2342
2343
2344
2345

2346
2347
2348
2349
2350
2351
2352
2332
2333
2334
2335
2336
2337
2338

2339
2340
2341
2342
2343
2344

2345
2346
2347
2348
2349
2350
2351
2352







-
+





-
+







    int *decpt,			/* Decimal point to set to a bogus value. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval;

    *decpt = 9999;
    if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
	retval = ckalloc(9);
	retval = (char *)ckalloc(9);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = ckalloc(4);
	retval = (char *)ckalloc(4);
	strcpy(retval, "NaN");
	if (endPtr) {
	    *endPtr = retval + 3;
	}
    }
    return retval;
}
2369
2370
2371
2372
2373
2374
2375
2376

2377
2378
2379
2380
2381
2382
2383
2369
2370
2371
2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382
2383







-
+







 */

static inline char *
FormatZero(
    int *decpt,			/* Location of the decimal point. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval = ckalloc(2);
    char *retval = (char *)ckalloc(2);

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;
2915
2916
2917
2918
2919
2920
2921
2922

2923
2924
2925
2926
2927
2928
2929
2915
2916
2917
2918
2919
2920
2921

2922
2923
2924
2925
2926
2927
2928
2929







-
+







    eps.d = ieps * d + 7.;
    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;

    /*
     * Handle the peculiar case where the result has no significant digits.
     */

    retval = ckalloc(len + 1);
    retval = (char *)ckalloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
3026
3027
3028
3029
3030
3031
3032
3033

3034
3035
3036
3037
3038
3039
3040
3026
3027
3028
3029
3030
3031
3032

3033
3034
3035
3036
3037
3038
3039
3040







-
+







    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
    char *retval = (char *)ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
3190
3191
3192
3193
3194
3195
3196
3197

3198
3199
3200
3201
3202
3203
3204
3205
3206
3207

3208
3209
3210
3211
3212
3213
3214
3190
3191
3192
3193
3194
3195
3196

3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215







-
+










+







    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
    char *retval = (char *)ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
    int digit;			/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Current position in the output buffer. */
    (void)dPtr;

    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if (b < S) {
	b = 10 * b;
3390
3391
3392
3393
3394
3395
3396
3397

3398
3399
3400
3401
3402
3403
3404
3391
3392
3393
3394
3395
3396
3397

3398
3399
3400
3401
3402
3403
3404
3405







-
+







    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
    char *retval = (char *)ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_int mplus, mminus;	/* Bounds for roundoff. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
3598
3599
3600
3601
3602
3603
3604
3605

3606
3607
3608
3609
3610
3611
3612

3613
3614
3615
3616
3617
3618
3619
3599
3600
3601
3602
3603
3604
3605

3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621







-
+







+







    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = ckalloc(len + 1);
    char *retval = (char *)ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_err err;
    (void)dPtr;

    /*
     * b = bw * 2**b2 * 5**b5
     */

    if (mp_init_u64(&b, bw) != MP_OKAY) {
	return NULL;
3798
3799
3800
3801
3802
3803
3804
3805

3806
3807
3808
3809
3810
3811
3812
3800
3801
3802
3803
3804
3805
3806

3807
3808
3809
3810
3811
3812
3813
3814







-
+







    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = ckalloc(len+1);
    char *retval = (char *)ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int mminus;		/* 1/2 ulp below the result. */
    mp_int mplus;		/* 1/2 ulp above the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
4033
4034
4035
4036
4037
4038
4039
4040

4041
4042
4043
4044
4045
4046
4047
4048
4049

4050
4051
4052
4053
4054
4055
4056
4035
4036
4037
4038
4039
4040
4041

4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059







-
+









+







    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = ckalloc(len+1);
    char *retval = (char *)ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    int g;			/* Size of the current digit ground. */
    int i, j;
    mp_err err;
    (void)dPtr;

    /*
     * b = bw * 2**b2 * 5**b5
     * S = 2**s2 * 5*s5
     */

    if (mp_init(&dig) != MP_OKAY) {

Changes to generic/tclStringObj.c.

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
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







-
+












-
+








-
+








    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
	if (needed <= INT_MAX / 2) {
	    attempt = 2 * needed;
	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
	    ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
	    ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = ckrealloc(objPtr->bytes, attempt + 1);
	ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
343
344
345
346
347
348
349



350
351
352
353
354
355
356
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359







+
+
+







				 * negative, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    (void)file;
    (void)line;

    return Tcl_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */

/*
 *---------------------------------------------------------------------------
 *
877
878
879
880
881
882
883
884

885
886

887
888
889
890
891
892
893
880
881
882
883
884
885
886

887
888

889
890
891
892
893
894
895
896







-
+

-
+







	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */
	    if (objPtr->bytes == &tclEmptyString) {
		objPtr->bytes = ckalloc(length + 1);
		objPtr->bytes = (char *)ckalloc(length + 1);
	    } else {
		objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
		objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1);
	    }
	    stringPtr->allocated = length;
	}

	objPtr->length = length;
	objPtr->bytes[length] = 0;

983
984
985
986
987
988
989
990

991
992

993
994
995
996
997
998
999
986
987
988
989
990
991
992

993
994

995
996
997
998
999
1000
1001
1002







-
+

-
+







	    /*
	     * Need to enlarge the buffer.
	     */

	    char *newBytes;

	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = attemptckalloc(length + 1);
		newBytes = (char *)attemptckalloc(length + 1);
	    } else {
		newBytes = attemptckrealloc(objPtr->bytes, length + 1);
		newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1);
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	}
3579
3580
3581
3582
3583
3584
3585
3586

3587
3588
3589
3590
3591
3592
3593
3582
3583
3584
3585
3586
3587
3588

3589
3590
3591
3592
3593
3594
3595
3596







-
+







	check = bh + start;
	while (check + ln <= end) {
	    /*
	     * Look for the leading byte of the needle in the haystack
	     * starting at check and stopping when there's not enough room
	     * for the needle left.
	     */
	    check = memchr(check, bn[0], (end + 1 - ln) - check);
	    check = (unsigned char *)memchr(check, bn[0], (end + 1 - ln) - check);
	    if (check == NULL) {
		/* Leading byte not found -> needle cannot be found. */
		return -1;
	    }
	    /* Leading byte found, check rest of needle. */
	    if (0 == memcmp(check+1, bn+1, ln-1)) {
		/* Checks! Return the successful index. */
4162
4163
4164
4165
4166
4167
4168
4169

4170
4171


4172
4173
4174
4175
4176
4177
4178
4165
4166
4167
4168
4169
4170
4171

4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183







-
+


+
+







 *	representation is set to "String".
 *
 *----------------------------------------------------------------------
 */

static int
SetStringFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Interp *dummy,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    (void)dummy;

    if (!TclHasIntRep(objPtr, &tclStringType)) {
	String *stringPtr = stringAlloc(0);

	/*
	 * Convert whatever we have into an untyped value. Just A String.
	 */

Changes to generic/tclStubInit.c.

265
266
267
268
269
270
271

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







+







	*d = d2;
    }
    return result;
}

int TclBN_mp_expt_d_ex(const mp_int *a, unsigned int b, mp_int *c, int fast)
{
    (void)fast;
    return TclBN_mp_expt_u32(a, b, c);
}

mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
{
    return TclBN_mp_to_ubin(a, b, INT_MAX, NULL);
}
508
509
510
511
512
513
514
515

516
517
518
519
520
521
522
509
510
511
512
513
514
515

516
517
518
519
520
521
522
523







-
+







static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
   return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcmp
static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
   return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))(void *)uniCharNcasecmp
#endif
static int utfNcmp(const char *s1, const char *s2, unsigned int n){
   return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
}
#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp
static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
   return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);

Changes to generic/tclTest.c.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
33
34
35
36
37
38
39

40
41
42
43
44
45
46







-







 * Required for the TestChannelCmd and TestChannelEventCmd
 */
#include "tclIO.h"

/*
 * Declare external functions used in Windows tests.
 */

DLLEXPORT int		Tcltest_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */
223
224
225
226
227
228
229
230

231
232
233
234
235
236
237
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+







			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestbumpinterpepochObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestbytestringObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestpurebytesobjObjCmd(ClientData clientData,
static int		TestpurebytesobjObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TeststringbytesObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestcmdinfoCmd(void *dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
848
849
850
851
852
853
854

855
856
857
858
859
860
861
862
863
864
865
866


867
868
869
870
871
872
873
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864


865
866
867
868
869
870
871
872
873







+










-
-
+
+







    Tcl_Interp *interp,			/* Current interpreter. */
    int argc,				/* Number of arguments. */
    const char **argv)			/* Argument strings. */
{
    TestAsyncHandler *asyncPtr, *prevPtr;
    int id, code;
    static int nextId = 1;
    (void)dummy;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	asyncPtr = ckalloc(sizeof(TestAsyncHandler));
	asyncPtr->command = ckalloc(strlen(argv[2]) + 1);
	asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler));
	asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1);
	strcpy(asyncPtr->command, argv[2]);
        Tcl_MutexLock(&asyncTestMutex);
	asyncPtr->id = nextId;
	nextId++;
	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
                                            INT2PTR(asyncPtr->id));
	asyncPtr->nextPtr = firstHandler;
1056
1057
1058
1059
1060
1061
1062


1063
1064
1065
1066
1067
1068
1069
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071







+
+







TestbumpinterpepochObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *)interp;
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }
    iPtr->compileEpoch++;
    return TCL_OK;
}
1091
1092
1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107







+







TestcmdinfoCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option cmdName\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
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
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







+
+
+












+
+
+







static int
CmdProc1(
    void *clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)argc;
    (void)argv;

    Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL);
    return TCL_OK;
}

	/*ARGSUSED*/
static int
CmdProc2(
    void *clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)argc;
    (void)argv;

    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
    return TCL_OK;
}

static void
CmdDelProc1(
    void *clientData)	/* String to save. */
1223
1224
1225
1226
1227
1228
1229

1230
1231
1232
1233
1234
1235
1236
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Command token;
    int *l;
    char buf[30];
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
1286
1287
1288
1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310







+







    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_DString buffer;
    int result;
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option script\"", NULL);
	return TCL_ERROR;
    }

1383
1384
1385
1386
1387
1388
1389




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
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







+
+
+
+












-
+










+
+
+
+
+
+
+
+











-
+








+
+
+
+
+







    void *cmdClientData,	/* Client data associated with command
				 * procedure. */
    int argc,			/* Number of arguments. */
    const char *argv[])		/* Argument strings. */
{
    Tcl_DString *bufPtr = (Tcl_DString *) clientData;
    int i;
    (void)interp;
    (void)level;
    (void)cmdProc;
    (void)cmdClientData;

    Tcl_DStringAppendElement(bufPtr, command);

    Tcl_DStringStartSublist(bufPtr);
    for (i = 0;  i < argc;  i++) {
	Tcl_DStringAppendElement(bufPtr, argv[i]);
    }
    Tcl_DStringEndSublist(bufPtr);
}

static void
CmdTraceDeleteProc(
    void *clientData,	/* Unused. */
    void *dummy,	/* Unused. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int level,			/* Current trace level. */
    char *command,		/* The command being traced (after
				 * substitutions). */
    Tcl_CmdProc *cmdProc,	/* Points to command's command procedure. */
    void *cmdClientData,	/* Client data associated with command
				 * procedure. */
    int argc,			/* Number of arguments. */
    const char *argv[])		/* Argument strings. */
{
    (void)dummy;
    (void)level;
    (void)command;
    (void)cmdProc;
    (void)cmdClientData;
    (void)argc;
    (void)argv;

    /*
     * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
     * callback causes the for loop in TclNRExecuteByteCode that calls traces to
     * reference freed memory.
     */

    Tcl_DeleteTrace(interp, cmdTrace);
}

static int
ObjTraceProc(
    void *clientData,	/* unused */
    void *dummy,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int level,			/* Execution level */
    const char *command,	/* Command being executed */
    Tcl_Command token,		/* Command information */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter list */
{
    const char *word = Tcl_GetString(objv[0]);
    (void)dummy;
    (void)level;
    (void)token;
    (void)objc;
    (void)objv;

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
	return TCL_BREAK;
    } else if (!strcmp(word, "Continue")) {
1479
1480
1481
1482
1483
1484
1485


1486
1487
1488
1489
1490
1491
1492
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522







+
+







static int
TestcreatecommandCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	Tcl_CreateCommand(interp, "test_ns_basic::createdcommand",
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
1534
1535
1536
1537
1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565

1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582







-
+






+
+
+















-
+






+
+
+







	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
CreatedCommandProc(
    void *clientData,	/* String to return. */
    void *dummy,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    int found;
    (void)dummy;
    (void)argc;
    (void)argv;

    found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand",
	    &info);
    if (!found) {
	Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
		NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "CreatedCommandProc in ",
	    info.namespacePtr->fullName, NULL);
    return TCL_OK;
}

static int
CreatedCommandProc2(
    void *clientData,	/* String to return. */
    void *dummy,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    int found;
    (void)dummy;
    (void)argc;
    (void)argv;

    found = Tcl_GetCommandInfo(interp, "value:at:", &info);
    if (!found) {
	Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
		NULL);
	return TCL_ERROR;
    }
1571
1572
1573
1574
1575
1576
1577

1578
1579
1580
1581
1582
1583
1584
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621







+







TestdcallCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int i, id;
    (void)dummy;

    delInterp = Tcl_CreateInterp();
    Tcl_DStringInit(&delString);
    for (i = 1; i < argc; i++) {
	if (Tcl_GetInt(interp, argv[i], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
1637
1638
1639
1640
1641
1642
1643

1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655

1656
1657

1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672


1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684

1685
1686
1687
1688
1689
1690
1691
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692

1693
1694

1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1731







+











-
+

-
+















+
+











-
+







    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr;
    Tcl_Interp *slave;
    (void)dummy;

    if (argc != 4) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }

    slave = Tcl_GetSlave(interp, argv[1]);
    if (slave == NULL) {
	return TCL_ERROR;
    }

    dPtr = ckalloc(sizeof(DelCmd));
    dPtr = (DelCmd*)ckalloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
    dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(slave, argv[2], DelCmdProc, dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    void *clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr = (DelCmd *) clientData;
    (void)argc;
    (void)argv;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = clientData;
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_ResetResult(dPtr->interp);
    ckfree(dPtr->deleteCmd);
    ckfree(dPtr);
}

1705
1706
1707
1708
1709
1710
1711
1712

1713
1714
1715
1716


1717
1718
1719
1720
1721
1722
1723
1745
1746
1747
1748
1749
1750
1751

1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765







-
+




+
+







 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
TestdelassocdataCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key\"", NULL);
	return TCL_ERROR;
    }
    Tcl_DeleteAssocData(interp, argv[1]);
    return TCL_OK;
1741
1742
1743
1744
1745
1746
1747
1748

1749
1750
1751
1752
1753
1754
1755
1783
1784
1785
1786
1787
1788
1789

1790
1791
1792
1793
1794
1795
1796
1797







-
+







 *	type - One of 'shortest', 'e', 'f'
 *	shorten - Indicates that the 'shorten' flag should be passed in.
 *
 *-----------------------------------------------------------------------------
 */

static int
TestdoubledigitsObjCmd(void *unused,
TestdoubledigitsObjCmd(void *dummy,
				/* NULL */
		       Tcl_Interp* interp,
				/* Tcl interpreter */
		       int objc,
				/* Parameter count */
		       Tcl_Obj* const objv[])
				/* Parameter vector */
1773
1774
1775
1776
1777
1778
1779

1780
1781
1782
1783
1784
1785
1786
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829







+







    int type;
    int decpt;
    int signum;
    char* str;
    char* endPtr;
    Tcl_Obj* strObj;
    Tcl_Obj* retval;
    (void)dummy;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
	return TCL_ERROR;
    }
    status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
    if (status != TCL_OK) {
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851
1852
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896







+







TestdstringCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int count;
    (void)dummy;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "append") == 0) {
1882
1883
1884
1885
1886
1887
1888
1889

1890
1891
1892
1893
1894
1895
1896
1926
1927
1928
1929
1930
1931
1932

1933
1934
1935
1936
1937
1938
1939
1940







-
+







	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = ckalloc(100);
	    char *s = (char *)ckalloc(100);
	    strcpy(s, "This is a malloc-ed string");
	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
	} else if (strcmp(argv[2], "special") == 0) {
	    char *s = (char*)ckalloc(100) + 16;
	    strcpy(s, "This is a specially-allocated string");
	    Tcl_SetResult(interp, s, SpecialFree);
	} else {
1934
1935
1936
1937
1938
1939
1940
1941
1942


1943

1944
1945
1946
1947
1948
1949
1950
1978
1979
1980
1981
1982
1983
1984


1985
1986

1987
1988
1989
1990
1991
1992
1993
1994







-
-
+
+
-
+







}

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(blockPtr)
    char *blockPtr;			/* Block to free. */
static void SpecialFree(
    char *blockPtr			/* Block to free. */
{
) {
    ckfree(blockPtr - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
1975
1976
1977
1978
1979
1980
1981

1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995

1996
1997
1998
1999

2000
2001
2002
2003

2004
2005
2006
2007
2008
2009
2010
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039

2040
2041
2042
2043

2044
2045
2046
2047

2048
2049
2050
2051
2052
2053
2054
2055







+













-
+



-
+



-
+







    TclEncoding *encodingPtr;
    static const char *const optionStrings[] = {
	"create",	"delete",	NULL
    };
    enum options {
	ENC_CREATE,	ENC_DELETE
    };
    (void)dummy;

    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = ckalloc(sizeof(TclEncoding));
	encodingPtr = (TclEncoding*)ckalloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = ckalloc(length + 1);
	encodingPtr->toUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = ckalloc(length + 1);
	encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, length + 1);

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;
2041
2042
2043
2044
2045
2046
2047



2048
2049
2050
2051
2052
2053
2054
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102







+
+
+







    int dstLen,			/* The maximum length of output buffer. */
    int *srcReadPtr,		/* Filled with number of bytes read. */
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;
    (void)src;
    (void)flags;
    (void)statePtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
2073
2074
2075
2076
2077
2078
2079



2080
2081
2082
2083
2084
2085
2086
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137







+
+
+







    int dstLen,			/* The maximum length of output buffer. */
    int *srcReadPtr,		/* Filled with number of bytes read. */
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;
    (void)src;
    (void)flags;
    (void)statePtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
2094
2095
2096
2097
2098
2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
2145
2146
2147
2148
2149
2150
2151

2152
2153
2154
2155
2156
2157
2158
2159







-
+







    return TCL_OK;
}

static void
EncodingFreeProc(
    void *clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = clientData;
    TclEncoding *encodingPtr = (TclEncoding *)clientData;

    ckfree(encodingPtr->toUtfCmd);
    ckfree(encodingPtr->fromUtfCmd);
    ckfree(encodingPtr);
}

/*
2127
2128
2129
2130
2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192







+







    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, flags;
    const char *script;
    (void)dummy;

    flags = 0;
    if (objc == 3) {
	const char *global = Tcl_GetString(objv[2]);
	if (strcmp(global, "global") != 0) {
	    Tcl_AppendResult(interp, "bad value \"", global,
		    "\": must be global", NULL);
2171
2172
2173
2174
2175
2176
2177

2178
2179
2180
2181
2182
2183
2184
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237







+







TestevalobjvObjCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int evalGlobal;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "global word ?word ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &evalGlobal) != TCL_OK) {
	return TCL_ERROR;
2214
2215
2216
2217
2218
2219
2220
2221

2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240

2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260

2261
2262
2263
2264
2265
2266
2267
2267
2268
2269
2270
2271
2272
2273

2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313

2314
2315
2316
2317
2318
2319
2320
2321







-
+



















+



















-
+







 *	Manipulates the event queue as directed.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventObjCmd(
    void *unused,		/* Not used */
    void *dummy,		/* Not used */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    static const char *const subcommands[] = { /* Possible subcommands */
	"queue", "delete", NULL
    };
    int subCmdIndex;		/* Index of the chosen subcommand */
    static const char *const positions[] = { /* Possible queue positions */
	"head", "tail", "mark", NULL
    };
    int posIndex;		/* Index of the chosen position */
    static const Tcl_QueuePosition posNum[] = {
				/* Interpretation of the chosen position */
	TCL_QUEUE_HEAD,
	TCL_QUEUE_TAIL,
	TCL_QUEUE_MARK
    };
    TestEvent *ev;		/* Event to be queued */
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "subcommand",
	    TCL_EXACT, &subCmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch (subCmdIndex) {
    case 0:			/* queue */
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name position script");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[3], positions,
		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	ev = ckalloc(sizeof(TestEvent));
	ev = (TestEvent *)ckalloc(sizeof(TestEvent));
	ev->header.proc = TesteventProc;
	ev->header.nextPtr = NULL;
	ev->interp = interp;
	ev->command = objv[4];
	Tcl_IncrRefCount(ev->command);
	ev->tag = objv[2];
	Tcl_IncrRefCount(ev->tag);
2307
2308
2309
2310
2311
2312
2313

2314
2315
2316
2317
2318
2319
2320
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375







+







{
    TestEvent *ev = (TestEvent *) event;
    Tcl_Interp *interp = ev->interp;
    Tcl_Obj *command = ev->command;
    int result = Tcl_EvalObjEx(interp, command,
	    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
    int retval;
    (void)flags;

    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"    (command bound to \"testevent\" callback)");
	Tcl_BackgroundException(interp, TCL_ERROR);
	return 1;		/* Avoid looping on errors */
    }
2393
2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405

2406
2407
2408
2409
2410
2411
2412
2448
2449
2450
2451
2452
2453
2454

2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexithandlerCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int value;
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" create|delete value\"", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
2469
2470
2471
2472
2473
2474
2475
2476

2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
2525
2526
2527
2528
2529
2530
2531

2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprlongCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    long exprResult;
    char buf[4 + TCL_INTEGER_SPACE];
    int result;
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
2512
2513
2514
2515
2516
2517
2518
2519

2520
2521
2522
2523
2524
2525
2526

2527
2528
2529
2530
2531
2532
2533
2569
2570
2571
2572
2573
2574
2575

2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprlongobjCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument objects. */
{
    long exprResult;
    char buf[4 + TCL_INTEGER_SPACE];
    int result;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
2554
2555
2556
2557
2558
2559
2560
2561

2562
2563
2564
2565
2566
2567
2568

2569
2570
2571
2572
2573
2574
2575
2612
2613
2614
2615
2616
2617
2618

2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprdoubleCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    double exprResult;
    char buf[4 + TCL_DOUBLE_SPACE];
    int result;
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
2598
2599
2600
2601
2602
2603
2604
2605

2606
2607
2608
2609
2610
2611
2612

2613
2614
2615
2616
2617
2618
2619
2657
2658
2659
2660
2661
2662
2663

2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprdoubleobjCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument objects. */
{
    double exprResult;
    char buf[4 + TCL_DOUBLE_SPACE];
    int result;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
2640
2641
2642
2643
2644
2645
2646
2647

2648
2649
2650
2651


2652
2653
2654
2655
2656
2657
2658
2700
2701
2702
2703
2704
2705
2706

2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprstringCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
	return TCL_ERROR;
    }
    return Tcl_ExprString(interp, argv[1]);
}
2672
2673
2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684

2685
2686
2687
2688
2689
2690
2691
2734
2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754







-
+





+







 *	May create a link on disk.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilelinkCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Obj *contents;
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "source ?target?");
	return TCL_ERROR;
    }

    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
2739
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751

2752
2753
2754
2755
2756
2757
2758
2802
2803
2804
2805
2806
2807
2808

2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetassocdataCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *res;
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key\"", NULL);
	return TCL_ERROR;
    }
    res = (char *) Tcl_GetAssocData(interp, argv[1], NULL);
2777
2778
2779
2780
2781
2782
2783
2784

2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2841
2842
2843
2844
2845
2846
2847

2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862







-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetplatformCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static const char *const platformStrings[] = { "unix", "mac", "windows" };
    TclPlatformType *platform;
    (void)dummy;

    platform = TclGetPlatform();

    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		NULL);
	return TCL_ERROR;
2824
2825
2826
2827
2828
2829
2830

2831
2832
2833
2834
2835
2836
2837
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903







+







TestinterpdeleteCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Interp *slaveToDelete;
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" path\"", NULL);
	return TCL_ERROR;
    }
    slaveToDelete = Tcl_GetSlave(interp, argv[1]);
2882
2883
2884
2885
2886
2887
2888

2889
2890
2891
2892
2893
2894
2895
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962







+







    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = 123;
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg arg arg arg arg arg arg arg arg arg arg"
		" arg arg?\"", NULL);
	return TCL_ERROR;
    }
3111
3112
3113
3114
3115
3116
3117
3118

3119
3120
3121
3122
3123
3124
3125
3178
3179
3180
3181
3182
3183
3184

3185
3186
3187
3188
3189
3190
3191
3192







-
+







	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		stringVar = (char *)ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
3218
3219
3220
3221
3222
3223
3224
3225

3226
3227
3228
3229
3230
3231
3232
3285
3286
3287
3288
3289
3290
3291

3292
3293
3294
3295
3296
3297
3298
3299







-
+







	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = ckalloc(strlen(argv[5]) + 1);
		stringVar = (char *)ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
3327
3328
3329
3330
3331
3332
3333
3334

3335
3336
3337
3338
3339
3340
3341
3394
3395
3396
3397
3398
3399
3400

3401
3402
3403
3404
3405
3406
3407
3408







-
+







 *	Creates, deletes, and invokes variable links.
 *
 *----------------------------------------------------------------------
 */

static int
TestlinkarrayCmd(
    ClientData dummy,           /* Not used. */
    void *dummy,                /* Not used. */
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    static const char *LinkOption[] = {
        "update", "remove", "create", NULL
    };
3351
3352
3353
3354
3355
3356
3357

3358
3359
3360
3361
3362
3363
3364
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432







+







	TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
	TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
	TCL_LINK_BINARY
    };
    int optionIndex, typeIndex, readonly, i, size, length;
    char *name, *arg;
    Tcl_WideInt addr;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option args");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], LinkOption, "option", 0,
	    &optionIndex) != TCL_OK) {
3445
3446
3447
3448
3449
3450
3451
3452

3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467

3468
3469
3470
3471
3472
3473
3474
3513
3514
3515
3516
3517
3518
3519

3520
3521
3522
3523
3524
3525
3526

3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542







-
+






-








+







 *	Modifies the current C locale.
 *
 *----------------------------------------------------------------------
 */

static int
TestlocaleCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int index;
    const char *locale;

    static const char *const optionStrings[] = {
	"ctype", "numeric", "time", "collate", "monetary",
	"all",	NULL
    };
    static const int lcTypes[] = {
	LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
	LC_ALL
    };
    (void)dummy;

    /*
     * LC_CTYPE, etc. correspond to the indices for the strings.
     */

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "category ?locale?");
3508
3509
3510
3511
3512
3513
3514
3515

3516


3517
3518
3519
3520
3521
3522
3523
3576
3577
3578
3579
3580
3581
3582

3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593







-
+

+
+







 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
static void
CleanupTestSetassocdataTests(
    void *clientData,	/* Data to be released. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
    Tcl_Interp *dummy)		/* Interpreter being deleted. */
{
    (void)dummy;

    ckfree(clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
3532
3533
3534
3535
3536
3537
3538
3539

3540
3541
3542
3543
3544
3545
3546

3547
3548
3549
3550
3551
3552
3553
3602
3603
3604
3605
3606
3607
3608

3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparserObjCmd(
    void *clientData,	/* Not used. */
    void *dummy1,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;
    (void)dummy1;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
    if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
3588
3589
3590
3591
3592
3593
3594
3595

3596
3597
3598
3599
3600
3601
3602

3603
3604
3605
3606
3607
3608
3609
3659
3660
3661
3662
3663
3664
3665

3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprparserObjCmd(
    void *clientData,	/* Not used. */
    void *dummy1,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;
    (void)dummy1;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "expr length");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
    if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
3735
3736
3737
3738
3739
3740
3741
3742

3743
3744
3745
3746
3747

3748
3749
3750
3751
3752
3753
3754
3807
3808
3809
3810
3811
3812
3813

3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparsevarObjCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *value, *name, *termPtr;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName");
	return TCL_ERROR;
    }
    name = Tcl_GetString(objv[1]);
    value = Tcl_ParseVar(interp, name, &termPtr);
3776
3777
3778
3779
3780
3781
3782
3783

3784
3785
3786
3787
3788
3789
3790

3791
3792
3793
3794
3795
3796
3797
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparsevarnameObjCmd(
    void *clientData,	/* Not used. */
    void *dummy1,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int append, length, dummy;
    Tcl_Parse parse;
    (void)dummy1;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "script length append");
	return TCL_ERROR;
    }
    script = Tcl_GetStringFromObj(objv[1], &dummy);
    if (Tcl_GetIntFromObj(interp, objv[2], &length)) {
3839
3840
3841
3842
3843
3844
3845
3846

3847
3848
3849
3850
3851




3852
3853
3854
3855
3856
3857
3858
3913
3914
3915
3916
3917
3918
3919

3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936







-
+





+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpreferstableObjCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    (void)dummy;
    (void)objc;
    (void)objv;

    iPtr->packagePrefer = PKG_PREFER_STABLE;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
3868
3869
3870
3871
3872
3873
3874
3875

3876
3877
3878
3879
3880
3881

3882
3883
3884
3885
3886
3887
3888
3946
3947
3948
3949
3950
3951
3952

3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967







-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestprintObjCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_WideInt argv1 = 0;
    size_t argv2;
    (void)dummy;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
3933
3934
3935
3936
3937
3938
3939

3940
3941
3942
3943
3944
3945
3946
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026







+







    };
    enum options {
	REGEXP_INDICES, REGEXP_NOCASE,	REGEXP_ABOUT,	REGEXP_EXPANDED,
	REGEXP_MULTI,	REGEXP_NOCROSS,	REGEXP_NEWL,
	REGEXP_XFLAGS,
	REGEXP_LAST
    };
    (void)dummy;

    indices = 0;
    about = 0;
    cflags = REG_ADVANCED;
    eflags = 0;
    hasxflags = 0;

4239
4240
4241
4242
4243
4244
4245





4246
4247
4248
4249
4250
4251
4252
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337







+
+
+
+
+







static int
TestreturnObjCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)interp;
    (void)objc;
    (void)objv;

    return TCL_RETURN;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetassocdataCmd --
4262
4263
4264
4265
4266
4267
4268
4269

4270
4271
4272
4273
4274
4275

4276
4277
4278
4279
4280
4281
4282
4283

4284
4285
4286
4287
4288
4289
4290
4347
4348
4349
4350
4351
4352
4353

4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368

4369
4370
4371
4372
4373
4374
4375
4376







-
+






+







-
+







 *	data for this interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetassocdataCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *buf, *oldData;
    Tcl_InterpDeleteProc *procPtr;
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key data_item\"", NULL);
	return TCL_ERROR;
    }

    buf = ckalloc(strlen(argv[2]) + 1);
    buf = (char *)ckalloc(strlen(argv[2]) + 1);
    strcpy(buf, argv[2]);

    /*
     * If we previously associated a malloced value with the variable,
     * free it before associating a new value.
     */

4313
4314
4315
4316
4317
4318
4319
4320

4321
4322
4323
4324
4325
4326

4327
4328
4329
4330
4331
4332
4333
4399
4400
4401
4402
4403
4404
4405

4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420







-
+






+







 *	Sets the tclPlatform global variable.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetplatformCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    size_t length;
    TclPlatformType *platform;
    (void)dummy;

    platform = TclGetPlatform();

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" platform\"", NULL);
	return TCL_ERROR;
4368
4369
4370
4371
4372
4373
4374

4375
4376
4377
4378
4379
4380
4381
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469







+







TeststaticpkgCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int safe, loaded;
    (void)dummy;

    if (argc != 4) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
		argv[0], " pkgName safe loaded\"", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
4420
4421
4422
4423
4424
4425
4426

4427
4428
4429
4430
4431
4432
4433
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522







+







    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_DString buffer;
    const char *result;
    (void)dummy;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
		argv[0], " path\"", NULL);
	return TCL_ERROR;
    }
    result = Tcl_TranslateFileName(interp, argv[1], &buffer);
4461
4462
4463
4464
4465
4466
4467

4468
4469
4470
4471
4472
4473
4474
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564







+







TestupvarCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int flags = 0;
    (void)dummy;

    if ((argc != 5) && (argc != 6)) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
		argv[0], " level name ?name2? dest global\"", NULL);
	return TCL_ERROR;
    }

4513
4514
4515
4516
4517
4518
4519


4520
4521
4522
4523
4524
4525
4526
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618







+
+







static int
TestseterrorcodeCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;

    if (argc > 6) {
	Tcl_AppendResult(interp, "too many args", NULL);
	return TCL_ERROR;
    }
    switch (argc) {
    case 1:
	Tcl_SetErrorCode(interp, "NONE", NULL);
4566
4567
4568
4569
4570
4571
4572


4573
4574
4575
4576
4577
4578
4579
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673







+
+







static int
TestsetobjerrorcodeCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    (void)dummy;

    Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
4590
4591
4592
4593
4594
4595
4596
4597

4598
4599
4600
4601
4602
4603
4604

4605
4606
4607
4608
4609
4610
4611
4684
4685
4686
4687
4688
4689
4690

4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706







-
+







+







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

	/* ARGSUSED */
static int
TestfeventCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static Tcl_Interp *interp2 = NULL;
    int code;
    Tcl_Channel chan;
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg ...?", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "cmd") == 0) {
4668
4669
4670
4671
4672
4673
4674


4675
4676
4677
4678
4679
4680
4681
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778







+
+







TestpanicCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *argString;
    (void)dummy;
    (void)interp;

    /*
     *  Put the arguments into a var args structure
     *  Append all of the arguments together separated by spaces
     */

    argString = Tcl_Merge(argc-1, argv+1);
4691
4692
4693
4694
4695
4696
4697

4698
4699
4700
4701
4702
4703
4704
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    Tcl_Obj *const argv[])	/* The argument objects. */
{
    int force, i, j, result;
    Tcl_Obj *error = NULL;
    const char *subcmd;
    (void)dummy;

    if (argc < 3) {
	return TCL_ERROR;
    }

    force = 0;
    i = 2;
4775
4776
4777
4778
4779
4780
4781

4782
4783
4784
4785
4786
4787
4788
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887







+







    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *name, *arg;
    int flags = 0;
    Tcl_Namespace *namespacePtr;
    Tcl_CallFrame *framePtr;
    Tcl_Var variable;
    (void)dummy;

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

    name = Tcl_GetString(objv[1]);
4839
4840
4841
4842
4843
4844
4845
4846

4847
4848
4849


4850
4851
4852
4853
4854
4855
4856
4857



4858
4859
4860
4861
4862
4863

4864
4865
4866
4867
4868
4869
4870
4871
4872

4873
4874
4875

4876
4877
4878
4879
4880
4881
4882
4938
4939
4940
4941
4942
4943
4944

4945
4946


4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964

4965
4966
4967
4968
4969
4970
4971
4972
4973

4974
4975
4976

4977
4978
4979
4980
4981
4982
4983
4984







-
+

-
-
+
+








+
+
+





-
+








-
+


-
+







 *	Allocates and frees memory, sets a variable "a" in the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
GetTimesObjCmd(
    void *unused,		/* Unused. */
    void *dummy,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int notused1,			/* Number of arguments. */
    Tcl_Obj *const notused2[])	/* The argument objects. */
    int cobjc,			/* Number of arguments. */
    Tcl_Obj *const cobjv[])	/* The argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    int i, n;
    double timePer;
    Tcl_Time start, stop;
    Tcl_Obj *objPtr, **objv;
    const char *s;
    char newString[TCL_INTEGER_SPACE];
    (void)dummy;
    (void)cobjc;
    (void)cobjv;

    /* alloc & free 100000 times */
    fprintf(stderr, "alloc & free 100000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	objPtr = ckalloc(sizeof(Tcl_Obj));
	objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj));
	ckfree(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);

    /* alloc 5000 times */
    fprintf(stderr, "alloc 5000 6 word items\n");
    objv = ckalloc(5000 * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **)ckalloc(5000 * sizeof(Tcl_Obj *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	objv[i] = ckalloc(sizeof(Tcl_Obj));
	objv[i] = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj));
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);

    /* free 5000 times */
    fprintf(stderr, "free 5000 6 word items\n");
5018
5019
5020
5021
5022
5023
5024
5025

5026
5027
5028
5029





5030
5031
5032
5033
5034
5035
5036
5120
5121
5122
5123
5124
5125
5126

5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143







-
+




+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NoopCmd(
    void *unused,		/* Unused. */
    void *dummy,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int argc,			/* The number of arguments. */
    const char **argv)		/* The argument strings. */
{
    (void)dummy;
    (void)interp;
    (void)argc;
    (void)argv;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NoopObjCmd --
5045
5046
5047
5048
5049
5050
5051
5052

5053
5054
5055
5056





5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077

5078
5079
5080
5081
5082
5083

5084
5085
5086
5087
5088
5089
5090
5152
5153
5154
5155
5156
5157
5158

5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188

5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203







-
+




+
+
+
+
+




















-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NoopObjCmd(
    void *unused,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    (void)dummy;
    (void)interp;
    (void)objc;
    (void)objv;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TeststringbytesObjCmd --
 *	Returns bytearray value of the bytes in argument string rep
 *
 * Results:
 *	Returns the TCL_OK result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TeststringbytesObjCmd(
    void *unused,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    const unsigned char *p;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);
    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n));
5110
5111
5112
5113
5114
5115
5116
5117

5118
5119
5120
5121
5122

5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137

5138
5139
5140
5141
5142
5143
5144
5223
5224
5225
5226
5227
5228
5229

5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250

5251
5252
5253
5254
5255
5256
5257
5258







-
+





+














-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpurebytesobjObjCmd(
    ClientData unused,		/* Not used. */
    void *dummy,			/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Obj *objPtr;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?string?");
	return TCL_ERROR;
    }
    objPtr = Tcl_NewObj();
    /*
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    */
    memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
    if (objc == 2) {
	const char *s = Tcl_GetString(objv[1]);
	objPtr->length = objv[1]->length;
	objPtr->bytes = ckalloc(objPtr->length + 1);
	objPtr->bytes = (char *)ckalloc(objPtr->length + 1);
	memcpy(objPtr->bytes, s, objPtr->length);
	objPtr->bytes[objPtr->length] = 0;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

5157
5158
5159
5160
5161
5162
5163
5164

5165
5166
5167
5168
5169
5170

5171
5172
5173
5174
5175
5176
5177
5271
5272
5273
5274
5275
5276
5277

5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292







-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestbytestringObjCmd(
    void *unused,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n = 0;
    const char *p;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
    if ((p == NULL) || !Tcl_FetchIntRep(objv[1], properByteArrayType)) {
5296
5297
5298
5299
5300
5301
5302

5303
5304
5305
5306
5307
5308
5309
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425







+







    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
	RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
    };
    (void)dummy;

    /*
     * Parse arguments
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "type script discard");
5323
5324
5325
5326
5327
5328
5329
5330

5331
5332
5333
5334
5335
5336
5337
5439
5440
5441
5442
5443
5444
5445

5446
5447
5448
5449
5450
5451
5452
5453







-
+







    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = ckalloc(200);
	char *buf = (char *)ckalloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
5390
5391
5392
5393
5394
5395
5396

5397
5398
5399
5400
5401
5402
5403
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520







+







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

static void
TestsaveresultFree(
    char *blockPtr)
{
    (void)blockPtr;
    freeCount++;
}

/*
 *----------------------------------------------------------------------
 *
 * TestmainthreadCmd  --
5417
5418
5419
5420
5421
5422
5423



5424
5425
5426
5427
5428
5429
5430
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550







+
+
+







static int
TestmainthreadCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;
    (void)argv;

    if (argc == 1) {
	Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());

	Tcl_SetObjResult(interp, idObj);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "wrong # args", NULL);
5478
5479
5480
5481
5482
5483
5484





5485
5486
5487



5488
5489
5490
5491
5492
5493
5494
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609



5610
5611
5612
5613
5614
5615
5616
5617
5618
5619







+
+
+
+
+
-
-
-
+
+
+







static int
TestsetmainloopCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;
    (void)interp;
    (void)argc;
    (void)argv;

  exitMainLoop = 0;
  Tcl_SetMainLoop(MainLoop);
  return TCL_OK;
    exitMainLoop = 0;
    Tcl_SetMainLoop(MainLoop);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestexitmainloopCmd  --
 *
5507
5508
5509
5510
5511
5512
5513





5514
5515


5516
5517
5518
5519
5520
5521
5522
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643


5644
5645
5646
5647
5648
5649
5650
5651
5652







+
+
+
+
+
-
-
+
+







static int
TestexitmainloopCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    (void)dummy;
    (void)interp;
    (void)argc;
    (void)argv;

  exitMainLoop = 1;
  return TCL_OK;
    exitMainLoop = 1;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestChannelCmd --
 *
5531
5532
5533
5534
5535
5536
5537
5538

5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553

5554
5555
5556
5557
5558
5559
5560
5661
5662
5663
5664
5665
5666
5667

5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691







-
+















+







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

	/* ARGSUSED */
static int
TestChannelCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for result. */
    int argc,			/* Count of additional args. */
    const char **argv)		/* Additional arg strings. */
{
    const char *cmdName;	/* Sub command. */
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashSearch hSearch;	/* Search variable. */
    Tcl_HashEntry *hPtr;	/* Search variable. */
    Channel *chanPtr;		/* The actual channel. */
    ChannelState *statePtr;	/* state info for channel */
    Tcl_Channel chan;		/* The opaque type. */
    size_t len;			/* Length of subcommand string. */
    int IOQueued;		/* How much IO is queued inside channel? */
    char buf[TCL_INTEGER_SPACE];/* For sprintf. */
    int mode;			/* rw mode of the channel */
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" subcommand ?additional args..?\"", NULL);
	return TCL_ERROR;
    }
    cmdName = argv[1];
5645
5646
5647
5648
5649
5650
5651
5652

5653
5654
5655
5656
5657
5658
5659
5776
5777
5778
5779
5780
5781
5782

5783
5784
5785
5786
5787
5788
5789
5790







-
+







	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
	Tcl_UnregisterChannel(interp, chan);

	Tcl_CutChannel(chan);

	/* Remember the channel in the pool of detached channels */

	det = ckalloc(sizeof(TestChannel));
	det = (TestChannel *)ckalloc(sizeof(TestChannel));
	det->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }

5837
5838
5839
5840
5841
5842
5843
5844

5845
5846
5847
5848
5849
5850
5851
5968
5969
5970
5971
5972
5973
5974

5975
5976
5977
5978
5979
5980
5981
5982







-
+







	hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, "tclIO", NULL);
	if (hTblPtr == NULL) {
	    return TCL_OK;
	}
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	     hPtr != NULL;
	     hPtr = Tcl_NextHashEntry(&hSearch)) {
	    Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
	    Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr));
	}
	return TCL_OK;
    }

    if ((cmdName[0] == 'o') &&
	    (strncmp(cmdName, "outputbuffered", len) == 0)) {
	if (argc != 3) {
5878
5879
5880
5881
5882
5883
5884
5885

5886
5887
5888
5889
5890
5891
5892
6009
6010
6011
6012
6013
6014
6015

6016
6017
6018
6019
6020
6021
6022
6023







-
+







	}
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	     hPtr != NULL;
	     hPtr = Tcl_NextHashEntry(&hSearch)) {
	    chanPtr  = (Channel *) Tcl_GetHashValue(hPtr);
	    statePtr = chanPtr->state;
	    if (statePtr->flags & TCL_READABLE) {
		Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
		Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr));
	    }
	}
	return TCL_OK;
    }

    if ((cmdName[0] == 'r') && (strncmp(cmdName, "refcount", len) == 0)) {
	if (argc != 3) {
5935
5936
5937
5938
5939
5940
5941
5942

5943
5944
5945
5946
5947
5948
5949
6066
6067
6068
6069
6070
6071
6072

6073
6074
6075
6076
6077
6078
6079
6080







-
+







	    return TCL_OK;
	}
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    chanPtr = (Channel *) Tcl_GetHashValue(hPtr);
	    statePtr = chanPtr->state;
	    if (statePtr->flags & TCL_WRITABLE) {
		Tcl_AppendElement(interp, Tcl_GetHashKey(hTblPtr, hPtr));
		Tcl_AppendElement(interp, (char *)Tcl_GetHashKey(hTblPtr, hPtr));
	    }
	}
	return TCL_OK;
    }

    if ((cmdName[0] == 't') && (strncmp(cmdName, "transform", len) == 0)) {
	/*
6011
6012
6013
6014
6015
6016
6017

6018
6019
6020
6021
6022
6023
6024
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156







+







{
    Tcl_Obj *resultListPtr;
    Channel *chanPtr;
    ChannelState *statePtr;	/* state info for channel */
    EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
    const char *cmd;
    int index, i, mask, len;
    (void)dummy;

    if ((argc < 3) || (argc > 5)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" channelName cmd ?arg1? ?arg2?\"", NULL);
	return TCL_ERROR;
    }
    chanPtr = (Channel *) Tcl_GetChannel(interp, argv[1], NULL);
6043
6044
6045
6046
6047
6048
6049
6050

6051
6052
6053
6054
6055
6056
6057
6175
6176
6177
6178
6179
6180
6181

6182
6183
6184
6185
6186
6187
6188
6189







-
+







	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = ckalloc(sizeof(EventScriptRecord));
	esPtr = (EventScriptRecord *)ckalloc(sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
6213
6214
6215
6216
6217
6218
6219
6220

6221
6222
6223
6224
6225
6226

6227
6228
6229
6230
6231
6232
6233
6345
6346
6347
6348
6349
6350
6351

6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366







-
+






+







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

	/* ARGSUSED */
static int
TestSocketCmd(
    void *clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for result. */
    int argc,			/* Count of additional args. */
    const char **argv)		/* Additional arg strings. */
{
    const char *cmdName;	/* Sub command. */
    size_t len;			/* Length of subcommand string. */
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" subcommand ?additional args..?\"", NULL);
	return TCL_ERROR;
    }
    cmdName = argv[1];
6287
6288
6289
6290
6291
6292
6293

6294
6295
6296
6297
6298
6299
6300
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434







+







    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, length;
    const char *msg;
    (void)dummy;

    if (objc < 3) {
	/*
	 * Don't use Tcl_WrongNumArgs here, as that is the function
	 * we want to test!
	 */
	Tcl_AppendResult(interp, "insufficient arguments", NULL);
6345
6346
6347
6348
6349
6350
6351

6352
6353
6354
6355
6356
6357
6358
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *const ary[] = {
	"a", "b", "c", "d", "e", "f", NULL, NULL
    };
    int idx,target;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *),
	    "dummy", 0, &idx) != TCL_OK) {
6397
6398
6399
6400
6401
6402
6403

6404
6405
6406
6407
6408
6409
6410
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546







+







    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    const char *msg;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
	return TCL_ERROR;
6469
6470
6471
6472
6473
6474
6475
6476

6477
6478
6479
6480
6481
6482
6483
6605
6606
6607
6608
6609
6610
6611

6612
6613
6614
6615
6616
6617
6618
6619







-
+








    if (nativeRep != NULL) {
	/* Free the path */
	Tcl_DecrRefCount(nativeRep);
    }
}

static ClientData
static void *
TestReportDupInternalRep(
    void *clientData)
{
    Tcl_Obj *original = (Tcl_Obj *) clientData;

    Tcl_IncrRefCount(original);
    return clientData;
6726
6727
6728
6729
6730
6731
6732
6733

6734
6735
6736


6737
6738
6739
6740
6741
6742
6743
6744

6745
6746

6747
6748
6749
6750
6751
6752
6753
6862
6863
6864
6865
6866
6867
6868

6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881

6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892







-
+



+
+







-
+


+







{
    TestReport("utime", fileName, NULL);
    return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
}

static int
TestReportNormalizePath(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    Tcl_Obj *pathPtr,
    int nextCheckpoint)
{
    (void)dummy;

    TestReport("normalizepath", pathPtr, NULL);
    return nextCheckpoint;
}

static int
SimplePathInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)
    void **dummy)
{
    const char *str = Tcl_GetString(pathPtr);
    (void)dummy;

    if (strncmp(str, "simplefs:/", 10)) {
	return -1;
    }
    return TCL_OK;
}

6773
6774
6775
6776
6777
6778
6779

6780
6781
6782
6783
6784
6785
6786
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926







+







    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    const char *msg;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
	return TCL_ERROR;
6926
6927
6928
6929
6930
6931
6932
6933

6934
6935
6936
6937


6938
6939
6940
6941
6942
6943
6944
6945
6946
6947
6948
6949
6950
6951
6952
6953
6954
6955
6956

6957
6958
6959
6960


6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978

6979
6980
6981
6982


6983
6984
6985
6986
6987
6988
6989
7066
7067
7068
7069
7070
7071
7072

7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097

7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
7119
7120
7121

7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135







-
+




+
+


















-
+




+
+

















-
+




+
+








/*
 * Used to check correct string-length determining in Tcl_NumUtfChars
 */

static int
TestNumUtfCharsCmd(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	len = Tcl_NumUtfChars(Tcl_GetString(objv[1]), len);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindFirst
 */

static int
TestFindFirstCmd(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindFirst(Tcl_GetString(objv[1]), len), -1));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindLast
 */

static int
TestFindLastCmd(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;

    if (objc > 1) {
	int len = -1;

	if (objc > 2) {
	    (void) Tcl_GetIntFromObj(interp, objv[2], &len);
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_UtfFindLast(Tcl_GetString(objv[1]), len), -1));
7021
7022
7023
7024
7025
7026
7027

7028
7029
7030
7031
7032
7033
7034
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178
7179
7180
7181







+







    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int status, index, i;
    int regs[4];
    Tcl_Obj *regsObjs[4];
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "eax");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
7049
7050
7051
7052
7053
7054
7055
7056

7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067

7068
7069
7070
7071
7072
7073
7074
7196
7197
7198
7199
7200
7201
7202

7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222







-
+











+








/*
 * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
 */

static int
TestHashSystemHashCmd(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const Tcl_HashKeyType hkType = {
	TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
	NULL, NULL, NULL, NULL
    };
    Tcl_HashTable hash;
    Tcl_HashEntry *hPtr;
    int i, isNew, limit = 100;
    (void)dummy;

    if (objc>1 && Tcl_GetIntFromObj(interp, objv[1], &limit)!=TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_InitCustomHashTable(&hash, TCL_CUSTOM_TYPE_KEYS, &hkType);

7130
7131
7132
7133
7134
7135
7136


7137
7138
7139
7140
7141
7142
7143
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293







+
+







static int
TestgetintCmd(
    void *dummy,
    Tcl_Interp *interp,
    int argc,
    const char **argv)
{
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    } else {
	int val, i, total=0;

	for (i=1 ; i<argc ; i++) {
7157
7158
7159
7160
7161
7162
7163



7164
7165
7166
7167
7168
7169
7170
7171
7172
7173
7174
7175
7176
7177
7178

7179
7180
7181
7182
7183
7184
7185
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339







+
+
+















+







static int
TestlongsizeCmd(
    void *dummy,
    Tcl_Interp *interp,
    int argc,
    const char **argv)
{
    (void)dummy;
    (void)argv;

    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
    return TCL_OK;
}

static int
NREUnwind_callback(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    int none;
    (void)result;

    if (data[0] == INT2PTR(-1)) {
        Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1),
                INT2PTR(-1), NULL);
    } else if (data[1] == INT2PTR(-1)) {
        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
                INT2PTR(-1), NULL);
7194
7195
7196
7197
7198
7199
7200
7201

7202
7203
7204
7205



7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219

7220
7221
7222
7223
7224
7225
7226
7227
7228
7229



7230
7231
7232
7233
7234
7235
7236
7348
7349
7350
7351
7352
7353
7354

7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375

7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396







-
+




+
+
+













-
+










+
+
+







        Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
    }
    return TCL_OK;
}

static int
TestNREUnwind(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    (void)dummy;
    (void)objc;
    (void)objv;
    /*
     * Insure that callbacks effectively run at the proper level during the
     * unwinding of the NRE stack.
     */

    Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
            INT2PTR(-1), NULL);
    return TCL_OK;
}


static int
TestNRELevels(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    static ptrdiff_t *refDepth = NULL;
    ptrdiff_t depth;
    Tcl_Obj *levels[6];
    int i = 0;
    NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;
    (void)dummy;
    (void)objc;
    (void)objv;

    if (refDepth == NULL) {
	refDepth = &depth;
    }

    depth = (refDepth - &depth);

7276
7277
7278
7279
7280
7281
7282



7283
7284
7285
7286
7287
7288
7289
7436
7437
7438
7439
7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
7450
7451
7452







+
+
+







    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
    int result = TCL_OK, len;
    Tcl_Obj *objv[3];
    (void)dummy;
    (void)argc;
    (void)argv;

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
7564
7565
7566
7567
7568
7569
7570
7571

7572
7573
7574
7575


7576
7577
7578
7579
7580
7581
7582
7727
7728
7729
7730
7731
7732
7733

7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetencpathObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    (void)dummy;

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

    Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
    return TCL_OK;
7597
7598
7599
7600
7601
7602
7603
7604

7605
7606
7607
7608


7609
7610
7611
7612
7613
7614
7615
7762
7763
7764
7765
7766
7767
7768

7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782







-
+




+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetencpathObjCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    (void)dummy;

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

    Tcl_SetEncodingSearchPath(objv[1]);
    return TCL_OK;
7643
7644
7645
7646
7647
7648
7649

7650
7651
7652
7653
7654
7655
7656
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824







+







    static int foo = 0;
    int count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };
    (void)dummy;

    foo = 0;
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
7674
7675
7676
7677
7678
7679
7680


7681
7682
7683
7684
7685
7686
7687
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857







+
+







{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *callerNsPtr = varFramePtr->nsPtr;
    Tcl_Command resolvedCmdPtr = NULL;
    (void)context;
    (void)flags;

    /*
     * Just do something special on a cmd literal "z" in two cases:
     *  A)  when the caller is a proc "x", and the proc is either in "::" or in "::ns2".
     *  B) the caller's namespace is "ctx1" or "ctx2"
     */
    if ( (name[0] == 'z') && (name[1] == '\0') ) {
7761
7762
7763
7764
7765
7766
7767






7768
7769
7770
7771
7772
7773
7774
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950







+
+
+
+
+
+







InterpVarResolver(
    Tcl_Interp *interp,
    const char *name,
    Tcl_Namespace *context,
    int flags,
    Tcl_Var *rPtr)
{
    (void)interp;
    (void)name;
    (void)context;
    (void)flags;
    (void)rPtr;

    /*
     * Don't resolve the variable; use standard rules.
     */

    return TCL_CONTINUE;
}

7848
7849
7850
7851
7852
7853
7854
7855

7856
7857
7858
7859
7860




7861
7862

7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877

7878
7879
7880
7881
7882
7883
7884
7885
7886

7887
7888
7889
7890
7891
7892
7893
8024
8025
8026
8027
8028
8029
8030

8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041

8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056

8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074







-
+





+
+
+
+

-
+














-
+









+








    VarHashRefCount(var)++;
    return var;
}

static int
InterpCompiledVarResolver(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    const char *name,
    int length,
    Tcl_Namespace *context,
    Tcl_ResolvedVarInfo **rPtr)
{
    (void)dummy;
    (void)length;
    (void)context;

    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = ckalloc(sizeof(MyResolvedVarInfo));
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)ckalloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}

static int
TestInterpResolverCmd(
    void *clientData,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const table[] = {
        "down", "up", NULL
    };
    int idx;
#define RESOLVER_KEY "testInterpResolver"
    (void)dummy;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2]));

Changes to generic/tclTestObj.c.

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
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







-
+

-
+


-
+

-
+

-
+

-
+

-
+

-
+





-
+







 * Forward declarations for functions defined later in this file:
 */

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
			    const char *string, int *indexPtr);
static void		SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
static int		TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TestbignumobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestbooleanobjCmd(ClientData dummy,
static int		TestbooleanobjCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TestdoubleobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TestindexobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TestintobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int 		TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
static int 		TestlistobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TestobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
static int		TeststringobjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);

#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20

static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp)
{
    int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
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
180
181
182
183
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
180
181
182
183
184







-
+















+







 *	type.
 *
 *----------------------------------------------------------------------
 */

static int
TestbignumobjCmd(
    ClientData clientData,	/* unused */
    void *dummy,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    const char *const subcmds[] = {
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    };
    int index, varIndex;
    const char *string;
    mp_int bignumValue;
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &index) != TCL_OK) {
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367

368
369
370
371
372
373
374
354
355
356
357
358
359
360

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376







-
+







+







 *	have boolean type.
 *
 *----------------------------------------------------------------------
 */

static int
TestbooleanobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex, boolValue;
    const char *index, *subCmd;
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478







-
+








+







 *	have double type.
 *
 *----------------------------------------------------------------------
 */

static int
TestdoubleobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex;
    double doubleValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

571
572
573
574
575
576
577
578

579
580
581
582
583
584
585

586
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
621







-
+







+









+














-
+







 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestindexobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowAbbrev, index, index2, setError, i, result;
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};

    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	int offset;		/* Offset between table entries. */
	int index;		/* Selected index into table. */
    };
    struct IndexRep *indexRep;
    (void)dummy;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
	 * are properly cached in the object and returned on subsequent
	 * lookups.
	 */

	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;
624
625
626
627
628
629
630
631

632
633
634
635
636
637
638
629
630
631
632
633
634
635

636
637
638
639
640
641
642
643







-
+







    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }

    argv = ckalloc((objc-3) * sizeof(char *));
    argv = (const char **)ckalloc((objc-3) * sizeof(char *));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
660
661
662
663
664
665
666
667

668
669
670
671
672
673
674
675

676
677
678
679
680
681
682
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688







-
+








+







 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestintobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    Tcl_WideInt wideValue;
    const char *index, *subCmd, *string;
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

864
865
866
867
868
869
870
871

872
873
874
875
876
877
878
870
871
872
873
874
875
876

877
878
879
880
881
882
883
884







-
+







 *	Creates, manipulates and frees list objects.
 *
 *-----------------------------------------------------------------------------
 */

static int
TestlistobjCmd(
    ClientData clientData,	/* Not used */
    void *dummy,	/* Not used */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    /* Subcommands supported by this command */
    const char* subcommands[] = {
	"set",
887
888
889
890
891
892
893

894
895
896
897
898
899
900
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907







+








    const char* index;		/* Argument giving the variable number */
    int varIndex;		/* Variable number converted to binary */
    int cmdIndex;		/* Ordinal number of the subcommand */
    int first;			/* First index in the list */
    int count;			/* Count of elements in a list */
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);
    index = Tcl_GetString(objv[2]);
961
962
963
964
965
966
967
968

969
970
971
972
973
974
975
976

977
978
979
980
981
982
983
968
969
970
971
972
973
974

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991







-
+








+







 *	Creates and frees objects.
 *
 *----------------------------------------------------------------------
 */

static int
TestobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex, destIndex, i;
    const char *index, *subCmd, *string;
    const Tcl_ObjType *targetType;
    Tcl_Obj **varPtr;
    (void)dummy;

    if (objc < 2) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

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
1200
1201
1202
1181
1182
1183
1184
1185
1186
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







-
+















+







 *	have string type.
 *
 *----------------------------------------------------------------------
 */

static int
TeststringobjCmd(
    ClientData clientData,	/* Not used. */
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option, i, length;
#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "appendself",
	"appendself2", NULL
    };
    (void)dummy;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

1291
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1300
1301
1302
1303
1304
1305
1306

1307
1308
1309
1310
1311
1312
1313
1314







-
+







	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = (int) strPtr->allocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */
1345
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357
1358
1359
1354
1355
1356
1357
1358
1359
1360

1361
1362
1363
1364
1365
1366
1367
1368







-
+







	case 9:				/* maxchars */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
			Tcl_GetObjType("string"));
		strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->maxChars;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10:			/* appendself */

Changes to generic/tclTestProcBodyObj.c.

41
42
43
44
45
46
47
48

49
50

51
52
53
54
55
56
57
41
42
43
44
45
46
47

48
49

50
51
52
53
54
55
56
57







-
+

-
+







    int exportIt;		/* if 1, export the command */
} CmdTable;

/*
 * Declarations for functions defined in this file.
 */

static int	ProcBodyTestProcObjCmd(ClientData dummy,
static int	ProcBodyTestProcObjCmd(void *dummy,
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int	ProcBodyTestCheckObjCmd(ClientData dummy,
static int	ProcBodyTestCheckObjCmd(void *dummy,
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int	ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int	RegisterCommand(Tcl_Interp* interp,
			const char *namesp, const CmdTable *cmdTablePtr);

/*
 * List of commands to create when the package is loaded; must go after the
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
224
225
226
227
228
229
230

231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250







-
+











+







 *  Leaves an error message in the interp's result on error.
 *
 *----------------------------------------------------------------------
 */

static int
ProcBodyTestProcObjCmd(
    ClientData dummy,		/* context; not used */
    void *dummy,		/* context; not used */
    Tcl_Interp *interp,		/* the current interpreter */
    int objc,			/* argument count */
    Tcl_Obj *const objv[])	/* arguments */
{
    const char *fullName;
    Tcl_Command procCmd;
    Command *cmdPtr;
    Proc *procPtr = NULL;
    Tcl_Obj *bodyObjPtr;
    Tcl_Obj *myobjv[5];
    int result;
    (void)dummy;

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

    /*
323
324
325
326
327
328
329
330

331
332
333
334
335

336
337
338
339
340
341
342
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338
339
340
341
342
343
344







-
+





+







 *  Returns a standard Tcl code.
 *
 *----------------------------------------------------------------------
 */

static int
ProcBodyTestCheckObjCmd(
    ClientData dummy,		/* context; not used */
    void *dummy,		/* context; not used */
    Tcl_Interp *interp,		/* the current interpreter */
    int objc,			/* argument count */
    Tcl_Obj *const objv[])	/* arguments */
{
    const char *version;
    (void)dummy;

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

    version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);

Changes to generic/tclThread.c.

160
161
162
163
164
165
166
167

168
169
170
171
172
173
174
160
161
162
163
164
165
166

167
168
169
170
171
172
173
174







-
+







    /*
     * Grow the list of pointers if necessary, copying only non-NULL
     * pointers to the new list.
     */

    if (recPtr->num >= recPtr->max) {
	recPtr->max += 8;
	newList = ckalloc(recPtr->max * sizeof(void *));
	newList = (void **)ckalloc(recPtr->max * sizeof(void *));
	for (i=0,j=0 ; i<recPtr->num ; i++) {
	    if (recPtr->list[i] != NULL) {
		newList[j++] = recPtr->list[i];
	    }
	}
	if (recPtr->list != NULL) {
	    ckfree(recPtr->list);

Changes to generic/tclThreadAlloc.c.

158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172







-
+







	    tcachePtr = GetCache();		\
	}					\
	(cachePtr) = tcachePtr;			\
    } while (0)
#else
# define GETCACHE(cachePtr)			\
    do {					\
	(cachePtr) = TclpGetAllocCache();	\
	(cachePtr) = (Cache*)TclpGetAllocCache();	\
	if ((cachePtr) == NULL) {		\
	    (cachePtr) = GetCache();		\
	}					\
    } while (0)
#endif

/*
205
206
207
208
209
210
211
212

213
214

215
216
217
218
219
220
221
205
206
207
208
209
210
211

212
213

214
215
216
217
218
219
220
221







-
+

-
+







	Tcl_MutexUnlock(initLockPtr);
    }

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = TclpGetAllocCache();
    cachePtr = (Cache*)TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = TclpSysAlloc(sizeof(Cache), 0);
	cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache), 0);
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
        memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
242
243
244
245
246
247
248
249

250
251
252
253
254
255
256
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256







-
+







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

void
TclFreeAllocCache(
    void *arg)
{
    Cache *cachePtr = arg;
    Cache *cachePtr = (Cache*)arg;
    Cache **nextPtrPtr;
    unsigned int bucket;

    /*
     * Flush blocks.
     */

333
334
335
336
337
338
339
340

341
342
343
344
345
346
347
333
334
335
336
337
338
339

340
341
342
343
344
345
346
347







-
+







    blockPtr = NULL;
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = TclpSysAlloc(size, 0);
	blockPtr = (Block *)TclpSysAlloc(size, 0);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;
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
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







-
+


















-
+







	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
	    return Block2Ptr(blockPtr, bucket, reqSize);
	}
    } else if (size > MAXALLOC) {
	cachePtr->totalAssigned -= blockPtr->blockReqSize;
	cachePtr->totalAssigned += reqSize;
	blockPtr = TclpSysRealloc(blockPtr, size);
	blockPtr = (Block*)TclpSysRealloc(blockPtr, size);
	if (blockPtr == NULL) {
	    return NULL;
	}
	return Block2Ptr(blockPtr, NBUCKETS, reqSize);
    }

    /*
     * Finally, perform an expensive malloc/copy/free.
     */

    newPtr = TclpAlloc(reqSize);
    if (newPtr != NULL) {
	if (reqSize > blockPtr->blockReqSize) {
	    reqSize = blockPtr->blockReqSize;
	}
	memcpy(newPtr, ptr, reqSize);
	TclpFree(ptr);
    }
    return newPtr;
    return (char *)newPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadAllocObj --
 *
559
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585

586
587
588
589
590
591
592
559
560
561
562
563
564
565

566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584

585
586
587
588
589
590
591
592







-
+


















-
+







	    MoveObjs(sharedPtr, cachePtr, numMove);
	}
	Tcl_MutexUnlock(objLockPtr);
	if (cachePtr->numObjects == 0) {
	    Tcl_Obj *newObjsPtr;

	    cachePtr->numObjects = numMove = NOBJALLOC;
	    newObjsPtr = TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
	    newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
	    if (newObjsPtr == NULL) {
		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
	    }
	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
	    objPtr = cachePtr->firstObjPtr;	/* NULL */
	    while (--numMove >= 0) {
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
		objPtr = newObjsPtr + numMove;
	    }
	    cachePtr->firstObjPtr = newObjsPtr;
	}
    }

    /*
     * Pop the first object.
     */

    objPtr = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
    cachePtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
    cachePtr->numObjects--;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
717
718
719
720
721
722
723
724

725
726

727
728
729
730
731
732
733
717
718
719
720
721
722
723

724
725

726
727
728
729
730
731
732
733







-
+

-
+








    /*
     * Find the last object to be moved; set the next one (the first one not
     * to be moved) as the first object in the 'from' cache.
     */

    while (--numMove) {
	objPtr = objPtr->internalRep.twoPtrValue.ptr1;
	objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
    }
    fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
    fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * Move all objects as a block - they are already linked to each other, we
     * just have to update the first and last.
     */

    toPtr->lastPtr = objPtr;
762
763
764
765
766
767
768
769

770
771
772
773
774
775
776
762
763
764
765
766
767
768

769
770
771
772
773
774
775
776







-
+







    fromPtr->numObjects = keep;
    firstPtr = fromPtr->firstObjPtr;
    if (keep == 0) {
	fromPtr->firstObjPtr = NULL;
    } else {
	do {
	    lastPtr = firstPtr;
	    firstPtr = firstPtr->internalRep.twoPtrValue.ptr1;
	    firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1;
	} while (--keep > 0);
	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
    }

    /*
     * Move all objects as a block - they are already linked to each other, we
     * just have to update the first and last.
871
872
873
874
875
876
877


878
879
880
881
882
883
884
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886







+
+







}

static void
UnlockBucket(
    Cache *cachePtr,
    int bucket)
{
    (void)cachePtr;

    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PutBlocks --
1028
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040
1041
1042
1043
1044







-
+








	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = TclpSysAlloc(size, 0);
	    blockPtr = (Block*)TclpSysAlloc(size, 0);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.
1143
1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155
1156
1157
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
1159







-
+







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

void
TclFinalizeThreadAllocThread(void)
{
    Cache *cachePtr = TclpGetAllocCache();
    Cache *cachePtr = (Cache *)TclpGetAllocCache();
    if (cachePtr != NULL) {
	TclpFreeAllocCache(cachePtr);
    }
}

#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*

Changes to generic/tclThreadJoin.c.

226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240







-
+








void
TclRememberJoinableThread(
    Tcl_ThreadId id)		/* The thread to remember as joinable */
{
    JoinableThread *threadPtr;

    threadPtr = ckalloc(sizeof(JoinableThread));
    threadPtr = (JoinableThread *)ckalloc(sizeof(JoinableThread));
    threadPtr->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);

Changes to generic/tclThreadStorage.c.

81
82
83
84
85
86
87
88

89
90
91
92
93
94
95

96
97
98
99
100
101
102
81
82
83
84
85
86
87

88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+






-
+








static TSDTable *
TSDTableCreate(void)
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    tsdTablePtr = TclpSysAlloc(sizeof(TSDTable), 0);
    tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable), 0);
    if (tsdTablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    tsdTablePtr->allocated = 8;
    tsdTablePtr->tablePtr =
	    TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
	    (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated, 0);
    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
159


160
161
162
163
164
165
166
144
145
146
147
148
149
150

151
152
153
154
155
156
157


158
159
160
161
162
163
164
165
166







-
+






-
-
+
+








static void
TSDTableGrow(
    TSDTable *tsdTablePtr,
    sig_atomic_t atLeast)
{
    sig_atomic_t newAllocated = tsdTablePtr->allocated * 2;
    ClientData *newTablePtr;
    void **newTablePtr;
    sig_atomic_t i;

    if (newAllocated <= atLeast) {
	newAllocated = atLeast + 10;
    }

    newTablePtr = TclpSysRealloc(tsdTablePtr->tablePtr,
	    sizeof(ClientData) * newAllocated);
    newTablePtr = (void **)TclpSysRealloc(tsdTablePtr->tablePtr,
	    sizeof(void *) * newAllocated);
    if (newTablePtr == NULL) {
	Tcl_Panic("unable to reallocate TSDTable");
    }

    for (i = tsdTablePtr->allocated; i < newAllocated; ++i) {
	newTablePtr[i] = NULL;
    }
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
185
186
187
188
189
190
191

192
193
194
195
196
197
198
199







-
+







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

void *
TclThreadStorageKeyGet(
    Tcl_ThreadDataKey *dataKeyPtr)
{
    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);
    ClientData resultPtr = NULL;
    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
    sig_atomic_t offset = keyPtr->offset;

    if ((tsdTablePtr != NULL) && (offset > 0)
	    && (offset < tsdTablePtr->allocated)) {
	resultPtr = tsdTablePtr->tablePtr[offset];
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233







-
+







 */

void
TclThreadStorageKeySet(
    Tcl_ThreadDataKey *dataKeyPtr,
    void *value)
{
    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);
    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;

    if (tsdTablePtr == NULL) {
	tsdTablePtr = TSDTableCreate();
	TclpThreadSetMasterTSD(tsdMaster.key, tsdTablePtr);
    }

284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
284
285
286
287
288
289
290

291
292
293
294
295
296
297
298







-
+







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

void
TclFinalizeThreadDataThread(void)
{
    TSDTable *tsdTablePtr = TclpThreadGetMasterTSD(tsdMaster.key);
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetMasterTSD(tsdMaster.key);

    if (tsdTablePtr != NULL) {
	TSDTableDelete(tsdTablePtr);
	TclpThreadSetMasterTSD(tsdMaster.key, NULL);
    }
}


Changes to generic/tclThreadTest.c.

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
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







-
+










-
+




-
+

-
-
+
+







/*
 * Access to the list of threads and to the thread send results is guarded by
 * this mutex.
 */

TCL_DECLARE_MUTEX(threadMutex)

static int		ThreadObjCmd(ClientData clientData,
static int		ThreadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ThreadCreate(Tcl_Interp *interp, const char *script,
			    int joinable);
static int		ThreadList(Tcl_Interp *interp);
static int		ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
			    const char *script, int wait);
static int		ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id,
			    const char *result, int flags);

static Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
static Tcl_ThreadCreateType	NewTestThread(void *clientData);
static void		ListRemove(ThreadSpecificData *tsdPtr);
static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
static void		ThreadErrorProc(Tcl_Interp *interp);
static void		ThreadFreeProc(ClientData clientData);
static void		ThreadFreeProc(void *clientData);
static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
			    ClientData clientData);
static void		ThreadExitProc(ClientData clientData);
			    void *clientData);
static void		ThreadExitProc(void *clientData);
extern int		Tcltest_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * TclThread_Init --
 *
202
203
204
205
206
207
208
209

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233







-
+
















+







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

	/* ARGSUSED */
static int
ThreadObjCmd(
    ClientData dummy,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int option;
    static const char *const threadOptions[] = {
	"cancel", "create", "event", "exit", "id",
	"join", "names", "send", "wait", "errorproc",
	NULL
    };
    enum options {
	THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
	THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
	THREAD_WAIT, THREAD_ERRORPROC
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
	    &option) != TCL_OK) {
431
432
433
434
435
436
437
438

439
440
441
442
443
444
445
432
433
434
435
436
437
438

439
440
441
442
443
444
445
446







-
+







	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    ckfree(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = ckalloc(strlen(proc) + 1);
	errorProcString = (char *)ckalloc(strlen(proc) + 1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
552
553
554
555
556
557
558
559

560
561

562
563
564
565
566
567
568
553
554
555
556
557
558
559

560
561

562
563
564
565
566
567
568
569







-
+

-
+







 *	A Tcl script is executed in a new thread.
 *
 *------------------------------------------------------------------------
 */

Tcl_ThreadCreateType
NewTestThread(
    ClientData clientData)
    void *clientData)
{
    ThreadCtrl *ctrlPtr = clientData;
    ThreadCtrl *ctrlPtr = (ThreadCtrl *)clientData;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    char *threadEvalScript;

    /*
     * Initialize the interpreter. This should be more general.
     */
591
592
593
594
595
596
597
598

599
600
601
602
603
604
605
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606







-
+







    ListUpdateInner(tsdPtr);

    /*
     * We need to keep a pointer to the alloc'ed mem of the script we are
     * eval'ing, for the case that we exit during evaluation
     */

    threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1);
    threadEvalScript = (char *)ckalloc(strlen(ctrlPtr->script) + 1);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);

    /*
     * Notify the parent we are alive.
     */
836
837
838
839
840
841
842
843
844


845
846
847
848
849

850
851
852
853
854
855
856
837
838
839
840
841
842
843


844
845
846
847
848
849

850
851
852
853
854
855
856
857







-
-
+
+




-
+







	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = ckalloc(sizeof(ThreadEvent));
    threadEventPtr->script = ckalloc(strlen(script) + 1);
    threadEventPtr = (ThreadEvent*)ckalloc(sizeof(ThreadEvent));
    threadEventPtr->script = (char *)ckalloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = ckalloc(sizeof(ThreadEventResult));
	resultPtr = (ThreadEventResult *)ckalloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029







+







{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr;
    ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
    Tcl_Interp *interp = tsdPtr->interp;
    int code;
    const char *result, *errorCode, *errorInfo;
    (void)mask;

    if (interp == NULL) {
	code = TCL_ERROR;
	result = "no target interp!";
	errorCode = "THREAD";
	errorInfo = "";
    } else {
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048

1049
1050
1051
1052

1053
1054
1055
1056
1057
1058
1059
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049

1050
1051
1052
1053

1054
1055
1056
1057
1058
1059
1060
1061







-
+


-
+



-
+







	}
	result = Tcl_GetStringResult(interp);
    }
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = ckalloc(strlen(result) + 1);
	resultPtr->result = (char *)ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
	    resultPtr->errorCode = (char *)ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
	    resultPtr->errorInfo = (char *)ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);
1069
1070
1071
1072
1073
1074
1075
1076

1077
1078
1079
1080
1081
1082
1083
1084

1085
1086
1087
1088
1089
1090
1091
1071
1072
1073
1074
1075
1076
1077

1078
1079
1080
1081
1082
1083
1084
1085

1086
1087
1088
1089
1090
1091
1092
1093







-
+







-
+







 *    This is called from when we are exiting and memory needs
 *    to be freed.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *	Clears up mem specified in ClientData
 *	Clears up mem specified in clientData
 *
 *------------------------------------------------------------------------
 */

     /* ARGSUSED */
static void
ThreadFreeProc(
    ClientData clientData)
    void *clientData)
{
    if (clientData) {
	ckfree(clientData);
    }
}

/*
1105
1106
1107
1108
1109
1110
1111
1112

1113


1114
1115
1116
1117
1118
1119
1120
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124







-
+

+
+







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

     /* ARGSUSED */
static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    ClientData clientData)	/* dummy */
    void *dummy)	/* dummy */
{
    (void)dummy;

    if (eventPtr->proc == ThreadEventProc) {
	ckfree(((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
1140
1141
1142
1143
1144
1145
1146
1147

1148
1149

1150
1151
1152
1153
1154
1155
1156
1144
1145
1146
1147
1148
1149
1150

1151
1152

1153
1154
1155
1156
1157
1158
1159
1160







-
+

-
+







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

     /* ARGSUSED */
static void
ThreadExitProc(
    ClientData clientData)
    void *clientData)
{
    char *threadEvalScript = clientData;
    char *threadEvalScript = (char *)clientData;
    ThreadEventResult *resultPtr, *nextPtr;
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->interp != NULL) {
	ListRemove(tsdPtr);
    }
1195
1196
1197
1198
1199
1200
1201
1202

1203
1204
1205
1206
1207
1208
1209
1199
1200
1201
1202
1203
1204
1205

1206
1207
1208
1209
1210
1211
1212
1213







-
+







	     * Dang. The target is going away. Unblock the caller. The result
	     * string must be dynamically allocated because the main thread is
	     * going to call free on it.
	     */

	    const char *msg = "target thread died";

	    resultPtr->result = ckalloc(strlen(msg) + 1);
	    resultPtr->result = (char *)ckalloc(strlen(msg) + 1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}

Changes to generic/tclTimer.c.

178
179
180
181
182
183
184
185

186
187
188
189
190
191
192
178
179
180
181
182
183
184

185
186
187
188
189
190
191
192







-
+







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

static ThreadSpecificData *
InitTimer(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
	Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
    }
    return tsdPtr;
207
208
209
210
211
212
213
214

215
216


217
218
219
220
221
222
223
207
208
209
210
211
212
213

214
215

216
217
218
219
220
221
222
223
224







-
+

-
+
+







 *	Removes the timer and idle event sources and remaining events.
 *
 *----------------------------------------------------------------------
 */

static void
TimerExitProc(
    ClientData clientData)	/* Not used. */
    ClientData dummy)	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    (void)dummy;

    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
293
294
295
296
297
298
299
300

301
302
303
304
305
306
307
294
295
296
297
298
299
300

301
302
303
304
305
306
307
308







-
+







    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    timerHandlerPtr = ckalloc(sizeof(TimerHandler));
    timerHandlerPtr = (TimerHandler *)ckalloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;
394
395
396
397
398
399
400
401

402
403
404
405

406
407
408
409
410
411
412
395
396
397
398
399
400
401

402
403
404
405
406
407
408
409
410
411
412
413
414







-
+




+







 *	May update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();
    (void)dummy;

    if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
	    || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
	/*
	 * There is an idle handler or a pending timer event, so just poll.
	 */

452
453
454
455
456
457
458
459

460
461
462
463
464

465
466
467
468
469
470
471
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468
469
470
471
472
473
474







-
+





+







 *	May queue an event and update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Event *timerEvPtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();
    (void)dummy;

    if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
	/*
	 * Compute the timeout for the next timer on the list.
	 */

	Tcl_GetTime(&blockTime);
484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
487
488
489
490
491
492
493

494
495
496
497
498
499
500
501







-
+







	/*
	 * If the first timer has expired, stick an event on the queue.
	 */

	if (blockTime.sec == 0 && blockTime.usec == 0 &&
		!tsdPtr->timerPending) {
	    tsdPtr->timerPending = 1;
	    timerEvPtr = ckalloc(sizeof(Tcl_Event));
	    timerEvPtr = (Tcl_Event *)ckalloc(sizeof(Tcl_Event));
	    timerEvPtr->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*
522
523
524
525
526
527
528

529
530
531
532
533
534
535
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539







+







    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    TimerHandler *timerHandlerPtr, **nextPtrPtr;
    Tcl_Time time;
    int currentTimerId;
    ThreadSpecificData *tsdPtr = InitTimer();
    (void)evPtr;

    /*
     * Do nothing if timers aren't enabled. This leaves the event on the
     * queue, so we will get to it as soon as ServiceEvents() is called with
     * timers enabled.
     */

621
622
623
624
625
626
627
628

629
630
631
632
633
634
635
625
626
627
628
629
630
631

632
633
634
635
636
637
638
639







-
+







    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = ckalloc(sizeof(IdleHandler));
    idlePtr = (IdleHandler *)ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
	tsdPtr->idleList = idlePtr;
    } else {
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
802
803
804
805
806
807
808
809

810
811

812
813
814
815
816
817
818
779
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
823







-
+















+











-
+

-
+







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

	/* ARGSUSED */
int
Tcl_AfterObjCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    int length;
    int index = -1;
    static const char *const afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    assocPtr = (AfterAssocData *)Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
	assocPtr = ckalloc(sizeof(AfterAssocData));
	assocPtr = (AfterAssocData *)ckalloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
841
842
843
844
845
846
847
848

849
850
851
852
853
854
855
846
847
848
849
850
851
852

853
854
855
856
857
858
859
860







-
+







    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = ckalloc(sizeof(AfterInfo));
	afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);
921
922
923
924
925
926
927
928

929
930
931
932
933
934
935
926
927
928
929
930
931
932

933
934
935
936
937
938
939
940







-
+







	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    return TCL_ERROR;
	}
	afterPtr = ckalloc(sizeof(AfterInfo));
	afterPtr = (AfterInfo *)ckalloc(sizeof(AfterInfo));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);
1146
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157
1158
1159
1160
1151
1152
1153
1154
1155
1156
1157

1158
1159
1160
1161
1162
1163
1164
1165







-
+







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

static void
AfterProc(
    ClientData clientData)	/* Describes command to execute. */
{
    AfterInfo *afterPtr = clientData;
    AfterInfo *afterPtr = (AfterInfo *)clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;

    /*
     * First remove the callback from our list of callbacks; otherwise someone
1249
1250
1251
1252
1253
1254
1255
1256

1257
1258

1259

1260
1261
1262
1263
1264
1265
1266
1254
1255
1256
1257
1258
1259
1260

1261
1262

1263
1264
1265
1266
1267
1268
1269
1270
1271
1272







-
+

-
+

+







 */

	/* ARGSUSED */
static void
AfterCleanupProc(
    ClientData clientData,	/* Points to AfterAssocData for the
				 * interpreter. */
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
    Tcl_Interp *dummy)		/* Interpreter that is being deleted. */
{
    AfterAssocData *assocPtr = clientData;
    AfterAssocData *assocPtr = (AfterAssocData *)clientData;
    AfterInfo *afterPtr;
    (void)dummy;

    while (assocPtr->firstAfterPtr != NULL) {
	afterPtr = assocPtr->firstAfterPtr;
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {

Changes to generic/tclTomMathDecls.h.

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
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







+
+
+










+
-
+
+







#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)
#define MP_FREE(mem, size)                TclBNFree(mem)

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif

#ifdef __cplusplus
extern "C" {
#endif
MODULE_SCOPE mp_err	TclBN_s_mp_add_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE mp_ord	TclBN_s_mp_cmp_d(const mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
MODULE_SCOPE mp_err	TclBN_s_mp_div_3(const mp_int *a, mp_int *c, mp_digit *b);
MODULE_SCOPE mp_err	TclBN_s_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c);
MODULE_SCOPE mp_err	TclBN_s_mp_init_set(mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
MODULE_SCOPE void	TclBN_s_mp_reverse(unsigned char *s, size_t len);
MODULE_SCOPE void	TclBN_s_mp_set(mp_int *a, mp_digit b);
MODULE_SCOPE mp_err	TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
#ifdef __cplusplus

}
#endif

/* Rename the global symbols in libtommath to avoid linkage conflicts */

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#define bn_reverse TclBN_reverse
#define mp_add TclBN_mp_add
#define mp_add_d TclBN_s_mp_add_d

Changes to generic/tclTrace.c.

205
206
207
208
209
210
211

212
213
214
215
216
217
218
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219







+







    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335







-
+







	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
	resultListPtr = Tcl_NewObj();
	name = Tcl_GetString(objv[2]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    TraceVarInfo *tvarPtr = clientData;
	    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
	    char *q = ops;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*q = 'r';
		q++;
	    }
464
465
466
467
468
469
470
471

472
473
474
475
476
477
478
465
466
467
468
469
470
471

472
473
474
475
476
477
478
479







-
+







		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
504
505
506
507
508
509
510
511

512
513
514
515
516
517
518
505
506
507
508
509
510
511

512
513
514
515
516
517
518
519







-
+








	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		/*
		 * In checking the 'flags' field we must remove any extraneous
		 * flags which may have been temporarily added by various
		 * pieces of the trace mechanism.
		 */

573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588







-
+







	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = clientData;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

701
702
703
704
705
706
707
708

709
710
711
712
713
714
715
702
703
704
705
706
707
708

709
710
711
712
713
714
715
716







-
+







		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = ckalloc(
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)ckalloc(
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
737
738
739
740
741
742
743
744

745
746
747
748
749
750
751
738
739
740
741
742
743
744

745
746
747
748
749
750
751
752







-
+








	    name = Tcl_GetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = clientData;
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
776
777
778
779
780
781
782
783

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

784
785
786
787
788
789
790
791







-
+







	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
	    int numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = clientData;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919







-
+







		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = ckalloc(
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)ckalloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
935
936
937
938
939
940
941
942

943
944
945
946
947
948
949
936
937
938
939
940
941
942

943
944
945
946
947
948
949
950







-
+







	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    name = Tcl_GetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = clientData;
		TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
						)==flags)
966
967
968
969
970
971
972
973

974
975
976
977
978
979
980
967
968
969
970
971
972
973

974
975
976
977
978
979
980
981







-
+







	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewObj();
	name = Tcl_GetString(objv[3]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
	    TraceVarInfo *tvarPtr = clientData;
	    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

1045
1046
1047
1048
1049
1050
1051

1052
1053
1054
1055
1056
1057
1058
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060







+







    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;
    (void)flags;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return NULL;
    }

1121
1122
1123
1124
1125
1126
1127
1128

1129
1130
1131
1132
1133
1134
1135
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1137







-
+







	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    tracePtr = ckalloc(sizeof(CommandTrace));
    tracePtr = (CommandTrace *)ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;
1286
1287
1288
1289
1290
1291
1292
1293

1294
1295
1296
1297
1298
1299
1300
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302







-
+







    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceCommandInfo *tcmdPtr = clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int code;
    Tcl_DString cmd;

    tcmdPtr->refCount++;

    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)
	    && !Tcl_LimitExceeded(interp)) {
1432
1433
1434
1435
1436
1437
1438

1439
1440
1441
1442
1443
1444
1445
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448







+







{
    Interp *iPtr = (Interp *) interp;
    CommandTrace *tracePtr, *lastTracePtr;
    ActiveCommandTrace active;
    int curLevel;
    int traceCode = TCL_OK;
    Tcl_InterpState state = NULL;
    (void)numChars;

    if (cmdPtr->tracePtr == NULL) {
	return traceCode;
    }

    curLevel = iPtr->varFramePtr->level;

1464
1465
1466
1467
1468
1469
1470
1471

1472
1473
1474
1475
1476
1477
1478
1467
1468
1469
1470
1471
1472
1473

1474
1475
1476
1477
1478
1479
1480
1481







-
+







		tracePtr = tracePtr->nextPtr;
	    }
	} else {
	    active.reverseScan = 0;
	    active.nextTracePtr = tracePtr->nextPtr;
	}
	if (tracePtr->traceProc == TraceCommandProc) {
	    TraceCommandInfo *tcmdPtr = tracePtr->clientData;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData;

	    if (tcmdPtr->flags != 0) {
		tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
		tcmdPtr->curCode  = code;
		tcmdPtr->refCount++;
		if (state == NULL) {
		    state = Tcl_SaveInterpState(interp, code);
1605
1606
1607
1608
1609
1610
1611
1612

1613
1614
1615
1616
1617
1618
1619
1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1622







-
+







		    (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
		/*
		 * New style trace.
		 */

		if (tracePtr->flags & traceFlags) {
		    if (tracePtr->proc == TraceExecutionProc) {
			TraceCommandInfo *tcmdPtr = tracePtr->clientData;
			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData;

			tcmdPtr->curFlags = traceFlags;
			tcmdPtr->curCode = code;
		    }
		    traceCode = tracePtr->proc(tracePtr->clientData, interp,
			    curLevel, command, (Tcl_Command) cmdPtr, objc,
			    objv);
1684
1685
1686
1687
1688
1689
1690
1691

1692
1693
1694
1695
1696
1697
1698
1687
1688
1689
1690
1691
1692
1693

1694
1695
1696
1697
1698
1699
1700
1701







-
+







    char *commandCopy;
    int traceCode;

    /*
     * Copy the command characters into a new string.
     */

    commandCopy = TclStackAlloc(interp, numChars + 1);
    commandCopy = (char *)TclStackAlloc(interp, numChars + 1);
    memcpy(commandCopy, command, numChars);
    commandCopy[numChars] = '\0';

    /*
     * Call the trace function then free allocated storage.
     */

1720
1721
1722
1723
1724
1725
1726
1727

1728
1729
1730
1731
1732
1733
1734
1723
1724
1725
1726
1727
1728
1729

1730
1731
1732
1733
1734
1735
1736
1737







-
+







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

static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

    if (tcmdPtr->refCount-- <= 1) {
	ckfree(tcmdPtr);
    }
}

/*
1764
1765
1766
1767
1768
1769
1770
1771

1772
1773
1774

1775
1776
1777
1778
1779
1780
1781
1767
1768
1769
1770
1771
1772
1773

1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785







-
+



+







    const char *command,
    Tcl_Command cmdInfo,
    int objc,
    struct Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;
    (void)cmdInfo;

    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	/*
	 * Inside any kind of execution trace callback, we do not allow any
	 * further execution trace callbacks to be called for the same trace.
	 */

1915
1916
1917
1918
1919
1920
1921
1922

1923
1924
1925

1926
1927
1928
1929
1930
1931
1932
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928

1929
1930
1931
1932
1933
1934
1935
1936







-
+


-
+







	 * string in startLevel and startCmd so that we can delete this
	 * interpreter trace when it reaches the end of this proc.
	 */

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    size_t len = strlen(command) + 1;
	    unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = ckalloc(len);
	    tcmdPtr->startCmd = (char *)ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
	}
    }
1970
1971
1972
1973
1974
1975
1976
1977

1978
1979
1980
1981
1982
1983
1984
1974
1975
1976
1977
1978
1979
1980

1981
1982
1983
1984
1985
1986
1987
1988







-
+







    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceVarInfo *tvarPtr = clientData;
    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
    char *result;
    int code, destroy = 0;
    Tcl_DString cmd;
    int rewind = ((Interp *)interp)->execEnvPtr->rewind;

    /*
     * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
2162
2163
2164
2165
2166
2167
2168
2169

2170
2171
2172
2173
2174
2175
2176
2166
2167
2168
2169
2170
2171
2172

2173
2174
2175
2176
2177
2178
2179
2180







-
+








	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    tracePtr = ckalloc(sizeof(Trace));
    tracePtr = (Trace *)ckalloc(sizeof(Trace));
    tracePtr->level = level;
    tracePtr->proc = proc;
    tracePtr->clientData = clientData;
    tracePtr->delProc = delProc;
    tracePtr->nextPtr = iPtr->tracePtr;
    tracePtr->flags = flags;
    iPtr->tracePtr = tracePtr;
2225
2226
2227
2228
2229
2230
2231
2232

2233
2234
2235
2236
2237
2238
2239
2229
2230
2231
2232
2233
2234
2235

2236
2237
2238
2239
2240
2241
2242
2243







-
+







    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    ClientData clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = ckalloc(sizeof(StringTraceData));
    StringTraceData *data = (StringTraceData *)ckalloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
}

2259
2260
2261
2262
2263
2264
2265
2266

2267
2268
2269
2270
2271
2272
2273
2263
2264
2265
2266
2267
2268
2269

2270
2271
2272
2273
2274
2275
2276
2277







-
+







    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{
    StringTraceData *data = clientData;
    StringTraceData *data = (StringTraceData *)clientData;
    Command *cmdPtr = (Command *) commandInfo;
    const char **argv;		/* Args to pass to string trace proc */
    int i;

    /*
     * This is a bit messy because we have to emulate the old trace interface,
     * which uses strings for everything.
2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673
2674
2664
2665
2666
2667
2668
2669
2670

2671
2672
2673
2674
2675
2676
2677
2678







-
+







    active.nextPtr = iPtr->activeVarTracePtr;
    iPtr->activeVarTracePtr = &active;
    Tcl_Preserve(iPtr);
    if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
	    && (arrayPtr->flags & traceflags)) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
	active.varPtr = arrayPtr;
	for (tracePtr = Tcl_GetHashValue(hPtr);
	for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
		tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
2704
2705
2706
2707
2708
2709
2710
2711

2712
2713
2714
2715
2716
2717
2718
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722







-
+








    if (flags & TCL_TRACE_UNSETS) {
	flags |= TCL_TRACE_DESTROYED;
    }
    active.varPtr = varPtr;
    if (varPtr->flags & traceflags) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
	for (tracePtr = Tcl_GetHashValue(hPtr);
	for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
		tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    if (state == NULL) {
2942
2943
2944
2945
2946
2947
2948
2949

2950
2951
2952
2953
2954
2955
2956
2946
2947
2948
2949
2950
2951
2952

2953
2954
2955
2956
2957
2958
2959
2960







-
+







	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    flags &= flagMask;

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
    for (tracePtr = Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
    for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	if (tracePtr == NULL) {
	    goto updateFlags;
	}
	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
		&& (tracePtr->clientData == clientData)) {
	    break;
3101
3102
3103
3104
3105
3106
3107
3108

3109
3110
3111
3112
3113
3114
3115
3105
3106
3107
3108
3109
3110
3111

3112
3113
3114
3115
3116
3117
3118
3119







-
+







    /*
     * Find the relevant trace, if any, and return its clientData.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);

    if (hPtr) {
	VarTrace *tracePtr = Tcl_GetHashValue(hPtr);
	VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);

	if (prevClientData != NULL) {
	    for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
		if ((tracePtr->clientData == prevClientData)
			&& (tracePtr->traceProc == proc)) {
		    tracePtr = tracePtr->nextPtr;
		    break;
3202
3203
3204
3205
3206
3207
3208
3209

3210
3211
3212
3213
3214
3215
3216
3206
3207
3208
3209
3210
3211
3212

3213
3214
3215
3216
3217
3218
3219
3220







-
+







    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    int result;

    tracePtr = ckalloc(sizeof(VarTrace));
    tracePtr = (VarTrace *)ckalloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
3296
3297
3298
3299
3300
3301
3302
3303

3304
3305
3306
3307
3308
3309
3310
3300
3301
3302
3303
3304
3305
3306

3307
3308
3309
3310
3311
3312
3313
3314







-
+







#endif
    tracePtr->flags = tracePtr->flags & flagMask;

    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
    if (isNew) {
	tracePtr->nextPtr = NULL;
    } else {
	tracePtr->nextPtr = Tcl_GetHashValue(hPtr);
	tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr);
    }
    Tcl_SetHashValue(hPtr, tracePtr);

    /*
     * Mark the variable as traced so we know to call them.
     */

Changes to generic/tclUtil.c.

872
873
874
875
876
877
878
879

880
881
882
883
884
885
886
872
873
874
875
876
877
878

879
880
881
882
883
884
885
886







-
+







     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = ckalloc((size * sizeof(char *)) + length + 1);
    argv = (const char **)ckalloc((size * sizeof(char *)) + length + 1);

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
1577
1578
1579
1580
1581
1582
1583
1584

1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596

1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1577
1578
1579
1580
1581
1582
1583

1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613

1614
1615
1616
1617
1618
1619
1620
1621







-
+











-
+

















-
+








    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */

    if (argc == 0) {
	result = ckalloc(1);
	result = (char *)ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	flagPtr = ckalloc(argc);
	flagPtr = (char *)ckalloc(argc);
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - argc + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = ckalloc(bytesNeeded);
    result = (char *)ckalloc(bytesNeeded);
    dst = result;
    for (i = 0; i < argc; i++) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
	*dst = ' ';
	dst++;
    }
2012
2013
2014
2015
2016
2017
2018
2019

2020
2021
2022
2023
2024
2025
2026
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022
2023
2024
2025
2026







-
+







	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = ckalloc(bytesNeeded + argc);
    result = (char *)ckalloc(bytesNeeded + argc);

    for (p = result, i = 0;  i < argc;  i++) {
	int triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);
2475
2476
2477
2478
2479
2480
2481

2482
2483
2484
2485
2486
2487
2488
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489







+







				/* Pattern, which may contain special
				 * characters. */
    int ptnLen,			/* Length of Pattern */
    int flags)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;
    (void)flags;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;

    while (1) {
	/*
	 * See if we're at the end of both the pattern and the string. If so,
2747
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2775







-
+












-
+







     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);
	    char *newString = (char *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	    dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870

2871
2872
2873
2874
2875
2876
2877
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870

2871
2872
2873
2874
2875
2876
2877
2878







-
+












-
+







     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);
	    char *newString = (char *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		offset = element - dsPtr->string;
	    }

	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	    dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
	dst = dsPtr->string + dsPtr->length;
    }
2944
2945
2946
2947
2948
2949
2950
2951

2952
2953
2954
2955
2956

2957
2958
2959
2960
2961
2962
2963
2945
2946
2947
2948
2949
2950
2951

2952
2953
2954
2955
2956

2957
2958
2959
2960
2961
2962
2963
2964







-
+




-
+







	newsize = dsPtr->spaceAvl * 2;
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = ckalloc(dsPtr->spaceAvl);
	    char *newString = (char *)ckalloc(dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	    dsPtr->string = (char *)ckrealloc(dsPtr->string, dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*
3101
3102
3103
3104
3105
3106
3107
3108

3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119

3120
3121
3122
3123
3124
3125
3126
3102
3103
3104
3105
3106
3107
3108

3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119

3120
3121
3122
3123
3124
3125
3126
3127







-
+










-
+








    dsPtr->length = strlen(iPtr->result);
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    dsPtr->string = iPtr->result;
	    dsPtr->spaceAvl = dsPtr->length+1;
	} else {
	    dsPtr->string = ckalloc(dsPtr->length+1);
	    dsPtr->string = (char *)ckalloc(dsPtr->length+1);
	    memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
	    iPtr->freeProc(iPtr->result);
	}
	dsPtr->spaceAvl = dsPtr->length+1;
	iPtr->freeProc = NULL;
    } else {
	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = ckalloc(dsPtr->length+1);
	    dsPtr->string = (char *)ckalloc(dsPtr->length+1);
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
3259
3260
3261
3262
3263
3264
3265
3266

3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278


3279
3280
3281
3282
3283
3284
3285
3260
3261
3262
3263
3264
3265
3266

3267


3268
3269
3270
3271
3272
3273
3274
3275
3276

3277
3278
3279
3280
3281
3282
3283
3284
3285







-
+
-
-









-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_PrintDouble(
    Tcl_Interp *interp,		/* Interpreter whose tcl_precision variable
    Tcl_Interp *dummy,		/* Not used. */
				 * used to be used to control printing. It's
				 * ignored now. */
    double value,		/* Value to print as string. */
    char *dst)			/* Where to store converted value; must have
				 * at least TCL_DOUBLE_SPACE characters. */
{
    char *p, c;
    int exponent;
    int signum;
    char *digits;
    char *end;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));
    int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int));
    (void)dummy;

    /*
     * Handle NaN.
     */

    if (TclIsNaN(value)) {
	TclFormatNaN(value, dst);
3445
3446
3447
3448
3449
3450
3451
3452

3453
3454
3455
3456
3457
3458
3459
3445
3446
3447
3448
3449
3450
3451

3452
3453
3454
3455
3456
3457
3458
3459







-
+







    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj *value;
    Tcl_WideInt prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));
    int *precisionPtr = (int *)Tcl_GetThreadData(&precisionKey, sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) {
4226
4227
4228
4229
4230
4231
4232
4233

4234
4235
4236
4237
4238
4239
4240
4226
4227
4228
4229
4230
4231
4232

4233
4234
4235
4236
4237
4238
4239
4240







-
+







    Tcl_HashTable *tablePtr)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_Obj *objPtr = Tcl_GetHashValue(hPtr);
	Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	Tcl_DecrRefCount(objPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
4256
4257
4258
4259
4260
4261
4262
4263

4264
4265
4266

4267
4268
4269
4270
4271
4272
4273
4256
4257
4258
4259
4260
4261
4262

4263
4264
4265

4266
4267
4268
4269
4270
4271
4272
4273







-
+


-
+







 */

static Tcl_HashTable *
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
	    (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
	*tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*
4284
4285
4286
4287
4288
4289
4290
4291

4292
4293
4294
4295
4296
4297
4298
4284
4285
4286
4287
4288
4289
4290

4291
4292
4293
4294
4295
4296
4297
4298







-
+







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

static void
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = clientData;
    Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*
4306
4307
4308
4309
4310
4311
4312
4313

4314
4315
4316
4317
4318
4319
4320
4306
4307
4308
4309
4310
4311
4312

4313
4314
4315
4316
4317
4318
4319
4320







-
+







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

static void
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = clientData;
    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    ckfree(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
4355
4356
4357
4358
4359
4360
4361
4362

4363
4364
4365
4366
4367
4368
4369
4355
4356
4357
4358
4359
4360
4361

4362
4363
4364
4365
4366
4367
4368
4369







-
+







    if (NULL != pgvPtr->value) {
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
    pgvPtr->value = (char *)ckalloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
4419
4420
4421
4422
4423
4424
4425
4426

4427
4428
4429
4430
4431
4432
4433
4419
4420
4421
4422
4423
4424
4425

4426
4427
4428
4429
4430
4431
4432
4433







-
+







	    epoch = ++pgvPtr->epoch;
	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
	    pgvPtr->value = (char *)ckalloc(Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
4469
4470
4471
4472
4473
4474
4475
4476

4477
4478
4479
4480
4481
4482
4483
4469
4470
4471
4472
4473
4474
4475

4476
4477
4478
4479
4480
4481
4482
4483







-
+







	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
	hPtr = Tcl_CreateHashEntry(cacheMap,
		INT2PTR(pgvPtr->epoch), &dummy);
	Tcl_MutexUnlock(&pgvPtr->mutex);
	Tcl_SetHashValue(hPtr, value);
	Tcl_IncrRefCount(value);
    }
    return Tcl_GetHashValue(hPtr);
    return (Tcl_Obj *)Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetObjNameOfExecutable --
 *

Changes to generic/tclVar.c.

264
265
266
267
268
269
270
271

272
273
274
275
276
277
278
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278







-
+







	Tcl_StoreIntRep((objPtr), &localVarNameType, &ir);		\
    } while (0)

#define LocalGetIntRep(objPtr, index, name)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &localVarNameType);		\
	(name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1;	\
    } while (0)

static const Tcl_ObjType parsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
};
290
291
292
293
294
295
296
297
298


299
300
301
302
303
304
305
290
291
292
293
294
295
296


297
298
299
300
301
302
303
304
305







-
-
+
+







    } while (0)

#define ParsedGetIntRep(objPtr, parsed, array, elem)			\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &parsedVarNameType);		\
	(parsed) = (irPtr != NULL);					\
	(array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
	(elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL;		\
	(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)

Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
996
997
998
999
1000
1001
1002
1003

1004
1005
1006
1007
1008
1009
1010
996
997
998
999
1000
1001
1002

1003
1004
1005
1006
1007
1008
1009
1010







-
+







		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = ckalloc(sizeof(TclVarHashTable));
		tablePtr = (TclVarHashTable *)ckalloc(sizeof(TclVarHashTable));
		TclInitVarHashTable(tablePtr, NULL);
		varFramePtr->varTablePtr = tablePtr;
	    }
	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
	} else {
	    varPtr = NULL;
	    if (tablePtr != NULL) {
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544







+







Tcl_SetObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;
    (void)dummy;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValueObj == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varValueObj);
2703
2704
2705
2706
2707
2708
2709
2710

2711
2712
2713
2714
2715
2716
2717
2704
2705
2706
2707
2708
2709
2710

2711
2712
2713
2714
2715
2716
2717
2718







-
+







	     * Transfer any existing traces on var, IF there are unset traces.
	     * Otherwise just delete them.
	     */

	    int isNew;

	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    tracePtr = Tcl_GetHashValue(tPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    varPtr->flags &= ~VAR_ALL_TRACES;
	    Tcl_DeleteHashEntry(tPtr);
	    if (dummyVar.flags & VAR_TRACED_UNSET) {
		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
			&dummyVar, &isNew);
		Tcl_SetHashValue(tPtr, tracePtr);
	    }
2730
2731
2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2731
2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2745







-
+







	     * the set of traces. If so, reload the traces to manipulate.
	     */

	    tracePtr = NULL;
	    if (TclIsVarTraced(&dummyVar)) {
		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
		if (tPtr) {
		    tracePtr = Tcl_GetHashValue(tPtr);
		    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
		    Tcl_DeleteHashEntry(tPtr);
		}
	    }
	}

	if (tracePtr) {
	    ActiveVarTrace *activePtr;
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836
2837
2838
2839
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, flags = TCL_LEAVE_ERR_MSG;
    const char *name;
    (void)dummy;

    if (objc == 1) {
	/*
	 * Do nothing if no arguments supplied, so as to match command
	 * documentation.
	 */

2896
2897
2898
2899
2900
2901
2902

2903
2904
2905
2906
2907
2908
2909
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr = NULL;
				/* Initialized to avoid compiler warning. */
    int i;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
2962
2963
2964
2965
2966
2967
2968

2969
2970
2971
2972
2973
2974
2975
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    int numElems, createdNewObj;
    Var *varPtr, *arrayPtr;
    int result;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
3169
3170
3171
3172
3173
3174
3175
3176

3177
3178
3179
3180
3181
3182
3183
3184

3185
3186
3187
3188
3189
3190
3191
3173
3174
3175
3176
3177
3178
3179

3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196







-
+








+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, ArrayForNRCmd, dummy, objc, objv);
}

static int
ArrayForNRCmd(
    ClientData dummy,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    int isArray, numVars;
    (void)dummy;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
3217
3218
3219
3220
3221
3222
3223
3224

3225
3226
3227
3228
3229
3230
3231
3222
3223
3224
3225
3226
3227
3228

3229
3230
3231
3232
3233
3234
3235
3236







-
+







	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255




3256
3257
3258
3259
3260
3261
3262
3250
3251
3252
3253
3254
3255
3256




3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267







-
-
-
-
+
+
+
+







static int
ArrayForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ArraySearch *searchPtr = data[0];
    Tcl_Obj *varListObj = data[1];
    Tcl_Obj *arrayNameObj = data[2];
    Tcl_Obj *scriptObj = data[3];
    ArraySearch *searchPtr = (ArraySearch *)data[0];
    Tcl_Obj *varListObj = (Tcl_Obj *)data[1];
    Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *arrayPtr;
    int done, varc;

    /*
3368
3369
3370
3371
3372
3373
3374
3375

3376
3377
3378
3379
3380
3381
3382
3373
3374
3375
3376
3377
3378
3379

3380
3381
3382
3383
3384
3385
3386
3387







-
+







    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
	searchPtr->nextPtr = (ArraySearch *)Tcl_GetHashValue(hPtr);
    }
    searchPtr->varPtr = varPtr;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
	    TclGetString(arrayNameObj));
3400
3401
3402
3403
3404
3405
3406
3407

3408
3409
3410
3411
3412
3413
3414

3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433

3434
3435
3436
3437
3438
3439
3440
3405
3406
3407
3408
3409
3410
3411

3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438

3439
3440
3441
3442
3443
3444
3445
3446







-
+







+


















-
+







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

	/* ARGSUSED */

static int
ArrayStartSearchCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    int isArray;
    ArraySearch *searchPtr;
    (void)dummy;

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

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = ckalloc(sizeof(ArraySearch));
    searchPtr = (ArraySearch *)ckalloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3467
3468
3469
3470
3471
3472
3473
3474

3475
3476
3477
3478
3479
3480
3481
3473
3474
3475
3476
3477
3478
3479

3480
3481
3482
3483
3484
3485
3486
3487







-
+







	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
	for (prevPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); ; prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
}
3496
3497
3498
3499
3500
3501
3502
3503

3504
3505
3506
3507
3508
3509
3510
3511
3512

3513
3514
3515
3516
3517
3518
3519
3502
3503
3504
3505
3506
3507
3508

3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526







-
+









+







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

	/* ARGSUSED */
static int
ArrayAnyMoreCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    int gotValue, isArray;
    ArraySearch *searchPtr;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];
3575
3576
3577
3578
3579
3580
3581
3582

3583
3584
3585
3586
3587
3588
3589
3590

3591
3592
3593
3594
3595
3596
3597
3582
3583
3584
3585
3586
3587
3588

3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605







-
+








+







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

	/* ARGSUSED */
static int
ArrayNextElementCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];
3656
3657
3658
3659
3660
3661
3662
3663

3664
3665
3666
3667
3668
3669
3670
3671
3672

3673
3674
3675
3676
3677
3678
3679
3664
3665
3666
3667
3668
3669
3670

3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688







-
+









+







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

	/* ARGSUSED */
static int
ArrayDoneSearchCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;
    (void)dummy;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];
3717
3718
3719
3720
3721
3722
3723
3724

3725
3726
3727
3728
3729
3730

3731
3732
3733
3734
3735
3736
3737
3726
3727
3728
3729
3730
3731
3732

3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747







-
+






+







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

	/* ARGSUSED */
static int
ArrayExistsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *)interp;
    int isArray;
    (void)dummy;

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

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) {
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
3768
3769
3770
3771
3772
3773
3774

3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793







-
+










+







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

	/* ARGSUSED */
static int
ArrayGetCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
    int i, count, result, isArray;
    (void)dummy;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
3918
3919
3920
3921
3922
3923
3924
3925

3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938

3939
3940
3941
3942
3943
3944
3945
3929
3930
3931
3932
3933
3934
3935

3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957







-
+













+







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

	/* ARGSUSED */
static int
ArrayNamesCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
    Var *varPtr, *varPtr2;
    Tcl_Obj *nameObj, *resultObj, *patternObj;
    Tcl_HashSearch search;
    const char *pattern = NULL;
    int isArray, mode = OPT_GLOB;
    (void)dummy;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
	return TCL_ERROR;
    }
    patternObj = (objc > 2 ? objv[objc-1] : NULL);

4086
4087
4088
4089
4090
4091
4092
4093

4094
4095
4096
4097
4098
4099
4100
4101

4102
4103
4104
4105
4106
4107
4108
4098
4099
4100
4101
4102
4103
4104

4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121







-
+








+







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

	/* ARGSUSED */
static int
ArraySetCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Var *varPtr, *arrayPtr;
    int result, i;
    (void)dummy;

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

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
4262
4263
4264
4265
4266
4267
4268
4269

4270
4271
4272
4273
4274
4275
4276
4277

4278
4279
4280
4281
4282
4283
4284
4275
4276
4277
4278
4279
4280
4281

4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298







-
+








+







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

	/* ARGSUSED */
static int
ArraySizeCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_HashSearch search;
    Var *varPtr2;
    int isArray, size = 0;
    (void)dummy;

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

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
4322
4323
4324
4325
4326
4327
4328
4329

4330
4331
4332
4333
4334
4335
4336
4337

4338
4339
4340
4341
4342
4343
4344
4336
4337
4338
4339
4340
4341
4342

4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359







-
+








+







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

	/* ARGSUSED */
static int
ArrayStatsCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj;
    char *stats;
    int isArray;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

4377
4378
4379
4380
4381
4382
4383
4384

4385
4386
4387
4388
4389
4390
4391
4392
4393
4394

4395
4396
4397
4398
4399
4400
4401
4392
4393
4394
4395
4396
4397
4398

4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417







-
+










+







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

	/* ARGSUSED */
static int
ArrayUnsetCmd(
    ClientData clientData,
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    const int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;
    (void)dummy;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
5013
5014
5015
5016
5017
5018
5019

5020
5021
5022
5023
5024
5025
5026
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *objPtr, *tailPtr;
    const char *varName;
    const char *tail;
    int result, i;
    (void)dummy;

    /*
     * If we are not executing inside a Tcl procedure, just return.
     */

    if (!HasLocalVars(iPtr->varFramePtr)) {
	return TCL_OK;
5118
5119
5120
5121
5122
5123
5124

5125
5126
5127
5128
5129
5130
5131
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149







+







{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *tail, *cp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr;
    int i, result;
    Tcl_Obj *varNamePtr, *tailPtr;
    (void)dummy;

    for (i=1 ; i<objc ; i+=2) {
	/*
	 * Look up each variable in the current namespace context, creating it
	 * if necessary.
	 */

5249
5250
5251
5252
5253
5254
5255

5256
5257
5258
5259
5260
5261
5262
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CallFrame *framePtr;
    int result, hasLevel;
    Tcl_Obj *levelObj;
    (void)dummy;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?level? otherVar localVar ?otherVar localVar ...?");
	return TCL_ERROR;
    }

5355
5356
5357
5358
5359
5360
5361
5362

5363
5364
5365
5366
5367
5368
5369

5370
5371
5372
5373
5374
5375
5376
5374
5375
5376
5377
5378
5379
5380

5381
5382
5383
5384
5385
5386
5387

5388
5389
5390
5391
5392
5393
5394
5395







-
+






-
+







    char *end;

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);

	/* First look for same (Tcl_Obj *) */
	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->name == handleObj) {
		return searchPtr;
	    }
	}
	/* Fallback: do string compares. */
	for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
		return searchPtr;
	    }
	}
    }
    if ((handle[0] != 's') || (handle[1] != '-')
5414
5415
5416
5417
5418
5419
5420
5421

5422
5423
5424
5425
5426
5427
5428
5433
5434
5435
5436
5437
5438
5439

5440
5441
5442
5443
5444
5445
5446
5447







-
+







				 * deleted. */
{
    ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    ckfree(searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
5484
5485
5486
5487
5488
5489
5490
5491

5492
5493
5494
5495
5496
5497
5498
5503
5504
5505
5506
5507
5508
5509

5510
5511
5512
5513
5514
5515
5516
5517







-
+







	 * so we cannot let such things linger. That would be a leak.
	 *
	 * First we destroy all traces. ...
	 */

	if (TclIsVarTraced(varPtr)) {
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    VarTrace *tracePtr = Tcl_GetHashValue(tPtr);
	    VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    ActiveVarTrace *activePtr;

	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
5681
5682
5683
5684
5685
5686
5687
5688

5689
5690
5691
5692
5693
5694
5695
5700
5701
5702
5703
5704
5705
5706

5707
5708
5709
5710
5711
5712
5713
5714







-
+







		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);

		elPtr->flags &= ~VAR_TRACE_ACTIVE;
		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
			elNamePtr, flags,/* leaveErrMsg */ 0, index);
	    }
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
	    tracePtr = Tcl_GetHashValue(tPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
	    }
6067
6068
6069
6070
6071
6072
6073

6074
6075
6076
6077
6078
6079
6080
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100







+







    Var *varPtr;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL;
    (void)dummy;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * variables. We only use this effective namespace if there's no active
     * Tcl procedure frame.
     */

6253
6254
6255
6256
6257
6258
6259

6260
6261
6262
6263
6264
6265
6266
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName, *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
    (void)dummy;

    if (objc == 1) {
	pattern = NULL;
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);

	/*
6343
6344
6345
6346
6347
6348
6349

6350
6351
6352
6353
6354
6355
6356
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378







+







    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *patternPtr, *listPtr;
    (void)dummy;

    if (objc == 1) {
	patternPtr = NULL;
    } else if (objc == 2) {
	patternPtr = objv[1];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
6487
6488
6489
6490
6491
6492
6493
6494

6495
6496
6497
6498
6499
6500
6501
6509
6510
6511
6512
6513
6514
6515

6516
6517
6518
6519
6520
6521
6522
6523







-
+







  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	Method *mPtr = (Method *)
		Tcl_ObjectContextMethod(iPtr->varFramePtr->clientData);
		Tcl_ObjectContextMethod((Tcl_ObjectContext)iPtr->varFramePtr->clientData);
	PrivateVariableMapping *privatePtr;

	if (mPtr->declaringObjectPtr) {
	    Object *oPtr = mPtr->declaringObjectPtr;

	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
6554
6555
6556
6557
6558
6559
6560
6561

6562
6563

6564
6565

6566
6567
6568
6569
6570
6571
6572
6576
6577
6578
6579
6580
6581
6582

6583
6584
6585
6586
6587

6588
6589
6590
6591
6592
6593
6594
6595







-
+


+

-
+







}

static Tcl_HashEntry *
AllocVarEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = keyPtr;
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;
    (void)tablePtr;

    varPtr = ckalloc(sizeof(VarInHash));
    varPtr = (Var *)ckalloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;
6594
6595
6596
6597
6598
6599
6600
6601

6602
6603
6604
6605
6606
6607
6608
6617
6618
6619
6620
6621
6622
6623

6624
6625
6626
6627
6628
6629
6630
6631







-
+







}

static int
CompareVarKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = keyPtr;
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    int l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller
6642
6643
6644
6645
6646
6647
6648
6649

6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660

6661
6662
6663
6664
6665
6666
6667
6665
6666
6667
6668
6669
6670
6671

6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691







-
+











+







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

	/* ARGSUSED */
static int
ArrayDefaultCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray, option;
    (void)dummy;

    /*
     * Parse arguments.
     */

    if (objc != 3 && objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
6788
6789
6790
6791
6792
6793
6794
6795

6796
6797
6798
6799
6800
6801
6802
6812
6813
6814
6815
6816
6817
6818

6819
6820
6821
6822
6823
6824
6825
6826







-
+







 * Initialize array variable.
 */

void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)ckalloc(sizeof(ArrayVarHashTable));

    /*
     * Mark the variable as an array.
     */

    TclSetVarArray(arrayPtr);

Changes to generic/tclZipfs.c.

843
844
845
846
847
848
849
850

851
852
853
854
855
856
857
843
844
845
846
847
848
849

850
851
852
853
854
855
856
857







-
+







    char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = Tcl_GetHashValue(hPtr);
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
    }
    return z;
}

/*
 *-------------------------------------------------------------------------
 *
931
932
933
934
935
936
937
938

939
940
941
942
943
944
945
931
932
933
934
935
936
937

938
939
940
941
942
943
944
945







-
+







    }
    if (zf->mountHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(zf->mountHandle);
    }
#else /* !_WIN32 */
    if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
	munmap(zf->data, zf->length);
	zf->data = MAP_FAILED;
	zf->data = (unsigned char *)MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	ckfree(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
1101
1102
1103
1104
1105
1106
1107
1108

1109
1110
1111
1112
1113
1114
1115
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1115







-
+








    zf->nameLength = 0;
    zf->isMemBuffer = 0;
#ifdef _WIN32
    zf->data = NULL;
    zf->mountHandle = INVALID_HANDLE_VALUE;
#else /* !_WIN32 */
    zf->data = MAP_FAILED;
    zf->data = (unsigned char *)MAP_FAILED;
#endif /* _WIN32 */
    zf->length = 0;
    zf->numFiles = 0;
    zf->baseOffset = zf->passOffset = 0;
    zf->ptrToFree = NULL;
    zf->passBuf[0] = 0;
    zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
1130
1131
1132
1133
1134
1135
1136
1137

1138
1139
1140
1141
1142
1143
1144
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143
1144







-
+







	    }
	    goto error;
	}
	if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	zf->ptrToFree = zf->data = attemptckalloc(zf->length);
	zf->ptrToFree = zf->data = (unsigned char *)attemptckalloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
1159
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172

1173
1174
1175
1176
1177
1178
1179
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171

1172
1173
1174
1175
1176
1177
1178
1179







-
+





-
+







	zf->length = GetFileSize((HANDLE) handle, 0);
	readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE);
#   endif /* _WIN64 */
	if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	zf->mountHandle = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY,
	zf->mountHandle = CreateFileMappingW((HANDLE) handle, 0, PAGE_READONLY,
		0, zf->length, 0);
	if (zf->mountHandle == INVALID_HANDLE_VALUE) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
	zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
	zf->data = (unsigned char *)MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
		zf->length);
	if (!zf->data) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#else /* !_WIN32 */
	zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
1261
1262
1263
1264
1265
1266
1267
1268

1269
1270
1271
1272
1273
1274
1275
1276
1277

1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290

1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327

1328
1329
1330
1331
1332
1333
1334
1261
1262
1263
1264
1265
1266
1267

1268
1269
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289

1290
1291
1292
1293

1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312

1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326

1327
1328
1329
1330
1331
1332
1333
1334







-
+








-
+












-
+



-
+


















-
+













-
+







	mountPoint = "";
    } else {
	mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
    }
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
    if (!isNew) {
	if (interp) {
	    zf = Tcl_GetHashValue(hPtr);
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s is already mounted on %s", zf->name, mountPoint));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    Unlock();

    *zf = *zf0;
    zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    Tcl_CreateExitHandler(ZipfsExitHandler, zf);
    zf->mountPointLen = strlen(zf->mountPoint);
    zf->nameLength = strlen(zipname);
    zf->name = ckalloc(zf->nameLength + 1);
    zf->name = (char *)ckalloc(zf->nameLength + 1);
    memcpy(zf->name, zipname, zf->nameLength + 1);
    zf->entries = NULL;
    zf->topEnts = NULL;
    zf->numOpen = 0;
    Tcl_SetHashValue(hPtr, zf);
    if ((zf->passBuf[0] == 0) && pwlen) {
	int k = 0;

	zf->passBuf[k++] = pwlen;
	for (i = pwlen; i-- > 0 ;) {
	    zf->passBuf[k++] = (passwd[i] & 0x0f)
		    | pwrot[(passwd[i] >> 4) & 0x0f];
	}
	zf->passBuf[k] = '\0';
    }
    if (mountPoint[0] != '\0') {
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew);
	if (isNew) {
	    z = ckalloc(sizeof(ZipEntry));
	    z = (ZipEntry *)ckalloc(sizeof(ZipEntry));
	    Tcl_SetHashValue(hPtr, z);

	    z->tnext = NULL;
	    z->depth = CountSlashes(mountPoint);
	    z->zipFilePtr = zf;
	    z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
	    z->isEncrypted = 0;
	    z->offset = zf->baseOffset;
	    z->crc32 = 0;
	    z->timestamp = 0;
	    z->numBytes = z->numCompressedBytes = 0;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->data = NULL;
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	}
    }
    q = zf->data + zf->directoryOffset;
    Tcl_DStringInit(&fpBuf);
    for (i = 0; i < zf->numFiles; i++) {
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1401
1402
1403
1404
1405
1406
1407

1408
1409
1410
1411
1412
1413
1414
1415







-
+







	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
	z = ckalloc(sizeof(ZipEntry));
	z = (ZipEntry *)ckalloc(sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
		&& (nbcompr > 12);
1433
1434
1435
1436
1437
1438
1439
1440

1441
1442
1443
1444
1445
1446
1447
1433
1434
1435
1436
1437
1438
1439

1440
1441
1442
1443
1444
1445
1446
1447







-
+







	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    ckfree(z);
	} else {
	    Tcl_SetHashValue(hPtr, z);
	    z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topEnts;
		zf->topEnts = z;
	    }
	    if (!z->isDirectory && (z->depth > 1)) {
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
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







-
+













-
+







		for (end = strrchr(dir, '/'); end && (end != dir);
			end = strrchr(dir, '/')) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			break;
		    }
		    zd = ckalloc(sizeof(ZipEntry));
		    zd = (ZipEntry *)ckalloc(sizeof(ZipEntry));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    Tcl_SetHashValue(hPtr, zd);
		    zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
		    zd->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
		    zd->next = zf->entries;
		    zf->entries = zd;
		    if ((mountPoint[0] == '\0') && (zd->depth == 1)) {
			zd->tnext = zf->topEnts;
			zf->topEnts = zd;
		    }
		}
1555
1556
1557
1558
1559
1560
1561
1562

1563
1564
1565
1566
1567
1568
1569
1555
1556
1557
1558
1559
1560
1561

1562
1563
1564
1565
1566
1567
1568
1569







-
+







    ZipFile *zf;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	if (!interp) {
	    return TCL_OK;
	}
	zf = Tcl_GetHashValue(hPtr);
	zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	Tcl_AppendElement(interp, zf->mountPoint);
	Tcl_AppendElement(interp, zf->name);
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
1592
1593
1594
1595
1596
1597
1598
1599

1600
1601
1602
1603
1604
1605
1606
1592
1593
1594
1595
1596
1597
1598

1599
1600
1601
1602
1603
1604
1605
1606







-
+







{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	    zf = Tcl_GetHashValue(hPtr);
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

1669
1670
1671
1672
1673
1674
1675
1676

1677
1678
1679
1680
1681
1682
1683
1669
1670
1671
1672
1673
1674
1675

1676
1677
1678
1679
1680
1681
1682
1683







-
+







		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
1750
1751
1752
1753
1754
1755
1756
1757

1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768

1769
1770
1771
1772
1773
1774
1775
1750
1751
1752
1753
1754
1755
1756

1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767

1768
1769
1770
1771
1772
1773
1774
1775







-
+










-
+







    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    zf = (ZipFile *)attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;
    if (copy) {
	zf->data = attemptckalloc(datalen);
	zf->data = (unsigned char *)attemptckalloc(datalen);
	if (!zf->data) {
	    if (interp) {
		Tcl_AppendResult(interp, "out of memory", (char *) NULL);
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    return TCL_ERROR;
	}
1831
1832
1833
1834
1835
1836
1837
1838

1839
1840
1841
1842
1843
1844
1845
1831
1832
1833
1834
1835
1836
1837

1838
1839
1840
1841
1842
1843
1844
1845







-
+








    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
    /* don't report no-such-mount as an error */
    if (!hPtr) {
	goto done;
    }

    zf = Tcl_GetHashValue(hPtr);
    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
    if (zf->numOpen > 0) {
	ZIPFS_ERROR(interp, "filesystem is busy");
	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);
    for (z = zf->entries; z; z = znext) {
1884
1885
1886
1887
1888
1889
1890


1891
1892
1893
1894
1895
1896
1897
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899







+
+







static int
ZipFSMountObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		 "?mountpoint? ?zipfile? ?password?");
	return TCL_ERROR;
    }

    return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
1921
1922
1923
1924
1925
1926
1927

1928
1929
1930
1931
1932
1933
1934
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint;	/* Mount point path. */
    unsigned char *data;
    int length;
    (void)dummy;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;
1970
1971
1972
1973
1974
1975
1976




1977
1978
1979
1980
1981
1982
1983
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990







+
+
+
+







static int
ZipFSRootObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
1997
1998
1999
2000
2001
2002
2003


2004
2005
2006
2007
2008
2009
2010
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019







+
+







static int
ZipFSUnmountObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
}

2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053







+







    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    char *pw, passBuf[264];
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = Tcl_GetString(objv[1]);
    len = strlen(pw);
2369
2370
2371
2372
2373
2374
2375
2376

2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391

2392
2393
2394
2395
2396
2397
2398
2379
2380
2381
2382
2383
2384
2385

2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2408







-
+














-
+







    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
	return TCL_ERROR;
    }

    z = ckalloc(sizeof(ZipEntry));
    z = (ZipEntry *)ckalloc(sizeof(ZipEntry));
    Tcl_SetHashValue(hPtr, z);
    z->name = NULL;
    z->tnext = NULL;
    z->depth = 0;
    z->zipFilePtr = NULL;
    z->isDirectory = 0;
    z->isEncrypted = (passwd ? 1 : 0);
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->numBytes = nbyte;
    z->numCompressedBytes = nbytecompr;
    z->compressMethod = compMeth;
    z->data = NULL;
    z->name = Tcl_GetHashKey(fileHash, hPtr);
    z->name = (char *)Tcl_GetHashKey(fileHash, hPtr);
    z->next = NULL;

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
2559
2560
2561
2562
2563
2564
2565
2566

2567
2568
2569
2570
2571
2572
2573
2569
2570
2571
2572
2573
2574
2575

2576
2577
2578
2579
2580
2581
2582
2583







-
+







	/*
	 * Check for mounted image.
	 */

	WriteLock();
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    zf = Tcl_GetHashValue(hPtr);
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    if (strcmp(zf->name, imgName) == 0) {
		isMounted = 1;
		zf->numOpen++;
		break;
	    }
	}
	Unlock();
2720
2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734
2730
2731
2732
2733
2734
2735
2736

2737
2738
2739
2740
2741
2742
2743
2744







-
+







	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = Tcl_GetHashValue(hPtr);
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
2775
2776
2777
2778
2779
2780
2781
2782

2783
2784
2785
2786
2787
2788
2789
2785
2786
2787
2788
2789
2790
2791

2792
2793
2794
2795
2796
2797
2798
2799







-
+







	ret = Tcl_Close(interp, out);
    } else {
	Tcl_Close(interp, out);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = Tcl_GetHashValue(hPtr);
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	ckfree(z);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

2807
2808
2809
2810
2811
2812
2813


2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833


2834
2835
2836
2837
2838
2839
2840
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854







+
+




















+
+







static int
ZipFSMkZipObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
}

static int
ZipFSLMkZipObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
2864
2865
2866
2867
2868
2869
2870


2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893







+
+







static int
ZipFSMkImgObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"outfile indir ?strip? ?password? ?infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
2885
2886
2887
2888
2889
2890
2891


2892
2893
2894
2895
2896
2897
2898
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916







+
+







static int
ZipFSLMkImgObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
2926
2927
2928
2929
2930
2931
2932

2933
2934
2935
2936
2937
2938
2939
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958







+







    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *mntpoint = NULL;
    char *filename = NULL;
    char *result;
    Tcl_DString dPath;
    (void)dummy;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if (objc == 2) {
2981
2982
2983
2984
2985
2986
2987

2988
2989
2990
2991
2992
2993
2994
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014







+







    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    int exists;
    Tcl_DString ds;
    (void)dummy;

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

    /*
3033
3034
3035
3036
3037
3038
3039

3040
3041
3042
3043
3044
3045
3046
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067







+







    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    ZipEntry *z;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = Tcl_GetString(objv[1]);
    ReadLock();
3086
3087
3088
3089
3090
3091
3092

3093
3094
3095
3096
3097
3098
3099
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121







+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *pattern = NULL;
    Tcl_RegExp regexp = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    (void)dummy;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	int n;
3115
3116
3117
3118
3119
3120
3121
3122

3123
3124
3125
3126
3127
3128
3129
3130
3131
3132

3133
3134
3135
3136
3137
3138
3139
3140
3141
3142

3143
3144
3145
3146
3147
3148
3149
3137
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







-
+









-
+









-
+







    } else if (objc == 2) {
	pattern = Tcl_GetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else if (regexp) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
		    Tcl_NewStringObj(z->name, -1));
	}
    }
    Unlock();
    return TCL_OK;
3278
3279
3280
3281
3282
3283
3284




3285
3286
3287
3288
3289
3290
3291
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317







+
+
+
+







static int
ZipFSTclLibraryObjCmd(
    void *dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    if (!Tcl_IsSafe(interp)) {
	Tcl_Obj *pResult = TclZipfs_TclLibrary();

	if (!pResult) {
	    pResult = Tcl_NewObj();
	}
	Tcl_SetObjResult(interp, pResult);
3310
3311
3312
3313
3314
3315
3316
3317


3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329

3330
3331
3332
3333
3334
3335
3336
3336
3337
3338
3339
3340
3341
3342

3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355

3356
3357
3358
3359
3360
3361
3362
3363







-
+
+











-
+







 */

static int
ZipChannelClose(
    void *instanceData,
    Tcl_Interp *dummy)		/* Current interpreter. */
{
    ZipChannel *info = instanceData;
    ZipChannel *info = (ZipChannel *)instanceData;
    (void)dummy;

    if (info->iscompr && info->ubuf) {
	ckfree(info->ubuf);
	info->ubuf = NULL;
    }
    if (info->isEncrypted) {
	info->isEncrypted = 0;
	memset(info->keys, 0, sizeof(info->keys));
    }
    if (info->isWriting) {
	ZipEntry *z = info->zipEntryPtr;
	unsigned char *newdata = attemptckrealloc(info->ubuf, info->numRead);
	unsigned char *newdata = (unsigned char *)attemptckrealloc(info->ubuf, info->numRead);

	if (newdata) {
	    if (z->data) {
		ckfree(z->data);
	    }
	    z->data = newdata;
	    z->numBytes = z->numCompressedBytes = info->numBytes;
3570
3571
3572
3573
3574
3575
3576



3577
3578
3579
3580
3581
3582
3583
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613







+
+
+







 */

static void
ZipChannelWatchChannel(
    void *instanceData,
    int mask)
{
    (void)instanceData;
    (void)mask;

    return;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelGetFile --
3596
3597
3598
3599
3600
3601
3602




3603
3604
3605
3606
3607
3608
3609
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643







+
+
+
+








static int
ZipChannelGetFile(
    void *instanceData,
    int direction,
    void **handlePtr)
{
    (void)instanceData;
    (void)direction;
    (void)handlePtr;

    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
3627
3628
3629
3630
3631
3632
3633

3634
3635
3636
3637
3638
3639
3640
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675







+







    int mode,
    int permissions)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    char cname[128];
    (void)permissions;

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unsupported open mode", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);
3683
3684
3685
3686
3687
3688
3689
3690

3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708

3709
3710
3711
3712
3713
3714
3715
3718
3719
3720
3721
3722
3723
3724

3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742

3743
3744
3745
3746
3747
3748
3749
3750







-
+

















-
+







		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = attemptckalloc(sizeof(ZipChannel));
    info = (ZipChannel *)attemptckalloc(sizeof(ZipChannel));
    if (!info) {
	ZIPFS_ERROR(interp, "out of memory");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	goto error;
    }
    info->zipFilePtr = z->zipFilePtr;
    info->zipEntryPtr = z;
    info->numRead = 0;
    if (wr) {
	flags |= TCL_WRITABLE;
	info->isWriting = 1;
	info->isDirectory = 0;
	info->maxWrite = ZipFS.wrmax;
	info->iscompr = 0;
	info->isEncrypted = 0;
	info->ubuf = attemptckalloc(info->maxWrite);
	info->ubuf = (unsigned char *)attemptckalloc(info->maxWrite);
	if (!info->ubuf) {
	merror0:
	    if (info->ubuf) {
		ckfree(info->ubuf);
	    }
	    ckfree(info);
	    ZIPFS_ERROR(interp, "out of memory");
3759
3760
3761
3762
3763
3764
3765
3766

3767
3768
3769
3770
3771
3772
3773
3794
3795
3796
3797
3798
3799
3800

3801
3802
3803
3804
3805
3806
3807
3808







-
+







		stream.zfree = Z_NULL;
		stream.opaque = Z_NULL;
		stream.avail_in = z->numCompressedBytes;
		if (z->isEncrypted) {
		    unsigned int j;

		    stream.avail_in -= 12;
		    cbuf = attemptckalloc(stream.avail_in);
		    cbuf = (unsigned char *)attemptckalloc(stream.avail_in);
		    if (!cbuf) {
			goto merror0;
		    }
		    for (j = 0; j < stream.avail_in; j++) {
			ch = info->ubuf[j];
			cbuf[j] = zdecode(info->keys, crc32tab, ch);
		    }
3859
3860
3861
3862
3863
3864
3865
3866

3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879

3880
3881
3882
3883
3884
3885
3886
3894
3895
3896
3897
3898
3899
3900

3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913

3914
3915
3916
3917
3918
3919
3920
3921







-
+












-
+







	    memset(&stream, 0, sizeof(z_stream));
	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->numCompressedBytes;
	    if (info->isEncrypted) {
		stream.avail_in -= 12;
		ubuf = attemptckalloc(stream.avail_in);
		ubuf = (unsigned char *)attemptckalloc(stream.avail_in);
		if (!ubuf) {
		    info->ubuf = NULL;
		    goto merror;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = ubuf;
	    } else {
		stream.next_in = info->ubuf;
	    }
	    stream.next_out = info->ubuf = attemptckalloc(info->numBytes);
	    stream.next_out = info->ubuf = (unsigned char *)attemptckalloc(info->numBytes);
	    if (!info->ubuf) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    ckfree(ubuf);
		}
4149
4150
4151
4152
4153
4154
4155


4156
4157
4158
4159
4160
4161
4162
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199







+
+







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

static Tcl_Obj *
ZipFSFilesystemSeparatorProc(
    Tcl_Obj *pathPtr)
{
    (void)pathPtr;

    return Tcl_NewStringObj("/", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMatchInDirectoryProc --
4186
4187
4188
4189
4190
4191
4192

4193
4194
4195
4196
4197
4198
4199
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237







+







    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, prefixLen, strip = 0;
    size_t len;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;
    (void)dummy;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }
4233
4234
4235
4236
4237
4238
4239
4240

4241
4242
4243
4244
4245
4246
4247
4271
4272
4273
4274
4275
4276
4277

4278
4279
4280
4281
4282
4283
4284
4285







-
+







	    l++;
	}
	if (!pattern || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = Tcl_GetHashValue(hPtr);
	    ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr);

	    if (zf->mountPointLen == 0) {
		ZipEntry *z;

		for (z = zf->topEnts; z; z = z->tnext) {
		    size_t lenz = strlen(z->name);

4284
4285
4286
4287
4288
4289
4290
4291

4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311

4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324

4325
4326
4327
4328
4329
4330
4331
4322
4323
4324
4325
4326
4327
4328

4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348

4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361

4362
4363
4364
4365
4366
4367
4368
4369







-
+



















-
+












-
+







	}
	goto end;
    }

    if (!pattern || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr) {
	    ZipEntry *z = Tcl_GetHashValue(hPtr);
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}
	    }
	}
	goto end;
    }

    l = strlen(pattern);
    pat = ckalloc(len + l + 2);
    pat = (char *)ckalloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
    }
    memcpy(pat + len, pattern, l + 1);
    scnt = CountSlashes(pat);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	    hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = Tcl_GetHashValue(hPtr);
	ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
		|| (!dirOnly && z->isDirectory))) {
	    continue;
	}
	if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
	    if (prefix) {
4371
4372
4373
4374
4375
4376
4377

4378
4379
4380
4381
4382
4383
4384
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423







+







    void **dummy)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    size_t len;
    char *path;
    (void)dummy;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }

    path = Tcl_GetString(pathPtr);
4393
4394
4395
4396
4397
4398
4399
4400

4401
4402
4403
4404
4405
4406
4407
4432
4433
4434
4435
4436
4437
4438

4439
4440
4441
4442
4443
4444
4445
4446







-
+







    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);
	ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		size_t lenz = strlen(z->name);

4472
4473
4474
4475
4476
4477
4478



4479
4480
4481
4482
4483
4484
4485
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527







+
+
+







	"-compsize",
	"-offset",
	"-mount",
	"-archive",
	"-permissions",
	NULL,
    };
    (void)pathPtr;
    (void)objPtrRef;

    return attrs;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsGetProc --
4573
4574
4575
4576
4577
4578
4579




4580
4581
4582
4583
4584
4585
4586
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632







+
+
+
+







static int
ZipFSFileAttrsSetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj *objPtr)
{
    (void)index;
    (void)pathPtr;
    (void)objPtr;

    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    }
    return TCL_ERROR;
}

4596
4597
4598
4599
4600
4601
4602

4603
4604
4605
4606
4607
4608
4609
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656







+







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

static Tcl_Obj *
ZipFSFilesystemPathTypeProc(
    Tcl_Obj *pathPtr)
{
    (void)pathPtr;
    return Tcl_NewStringObj("zip", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLoadFile --
4888
4889
4890
4891
4892
4893
4894

4895
4896

4897
4898

4899
4900
4901
4902
4903
4904
4905
4935
4936
4937
4938
4939
4940
4941
4942
4943

4944
4945

4946
4947
4948
4949
4950
4951
4952
4953







+

-
+

-
+







    char
#endif /* _WIN32 */
    ***argvPtr)			/* Pointer to argv */
{
    char *archive;

#ifdef _WIN32
    (void)argvPtr;
    Tcl_FindExecutable(NULL);
#else /* !_WIN32 */
#else
    Tcl_FindExecutable((*argvPtr)[0]);
#endif /* _WIN32 */
#endif
    archive = (char *) Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.
     */
4991
4992
4993
4994
4995
4996
4997


4998
4999
5000
5001
5002
5003
5004
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054







+
+







		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#else
	(void)argcPtr;
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
}

#ifndef HAVE_ZLIB

Changes to generic/tclZlib.c.

695
696
697
698
699
700
701
702

703
704
705
706
707
708
709
695
696
697
698
699
700
701

702
703
704
705
706
707
708
709







-
+







	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    if (dictObj) {
		gzHeaderPtr = ckalloc(sizeof(GzipHeader));
		gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader));
		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
			NULL) != TCL_OK) {
		    ckfree(gzHeaderPtr);
		    return TCL_ERROR;
		}
	    }
729
730
731
732
733
734
735
736

737
738
739
740
741
742
743
729
730
731
732
733
734
735

736
737
738
739
740
741
742
743







-
+








	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    gzHeaderPtr = ckalloc(sizeof(GzipHeader));
	    gzHeaderPtr = (GzipHeader *)ckalloc(sizeof(GzipHeader));
	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
	    gzHeaderPtr->header.name = (Bytef *)
		    gzHeaderPtr->nativeFilenameBuf;
	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
	    gzHeaderPtr->header.comment = (Bytef *)
		    gzHeaderPtr->nativeCommentBuf;
	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
755
756
757
758
759
760
761
762

763
764
765
766
767
768
769
755
756
757
758
759
760
761

762
763
764
765
766
767
768
769







-
+







	}
	break;
    default:
	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
		" TCL_ZLIB_STREAM_INFLATE");
    }

    zshPtr = ckalloc(sizeof(ZlibStreamHandle));
    zshPtr = (ZlibStreamHandle *)ckalloc(sizeof(ZlibStreamHandle));
    zshPtr->interp = interp;
    zshPtr->mode = mode;
    zshPtr->format = format;
    zshPtr->level = level;
    zshPtr->wbits = wbits;
    zshPtr->currentInput = NULL;
    zshPtr->streamEnd = 0;
882
883
884
885
886
887
888
889

890
891
892
893
894
895
896
882
883
884
885
886
887
888

889
890
891
892
893
894
895
896







-
+







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

static void
ZlibStreamCmdDelete(
    void *cd)
{
    ZlibStreamHandle *zshPtr = cd;
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd;

    zshPtr->cmd = NULL;
    ZlibStreamCleanup(zshPtr);
}

/*
 *----------------------------------------------------------------------
1229
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1229
1230
1231
1232
1233
1234
1235

1236
1237
1238
1239
1240
1241
1242
1243







-
+







	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;
	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = ckalloc(outSize);
	dataTmp = (char *)ckalloc(outSize);

	while (1) {
	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);

	    /*
	     * Test if we've filled the buffer up and have to ask deflate() to
	     * give us some more. Note that the condition for needing to
1263
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1263
1264
1265
1266
1267
1268
1269

1270
1271
1272
1273
1274
1275
1276
1277







-
+







	     */

	    AppendByteArray(zshPtr->outData, dataTmp, outSize);

	    if (outSize < BUFFER_SIZE_LIMIT) {
		outSize = BUFFER_SIZE_LIMIT;
		/* There may be *lots* of data left to output... */
		dataTmp = ckrealloc(dataTmp, outSize);
		dataTmp = (char *)ckrealloc(dataTmp, outSize);
	    }
	}

	/*
	 * And append the final data block to the outData list.
	 */

1748
1749
1750
1751
1752
1753
1754
1755

1756
1757
1758

1759
1760
1761
1762
1763
1764
1765
1748
1749
1750
1751
1752
1753
1754

1755
1756
1757

1758
1759
1760
1761
1762
1763
1764
1765







-
+


-
+







		"TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
		"TCL_ZLIB_FORMAT_AUTO");
    }

    if (gzipHeaderDictObj) {
	headerPtr = &header;
	memset(headerPtr, 0, sizeof(gz_header));
	nameBuf = ckalloc(MAXPATHLEN);
	nameBuf = (char *)ckalloc(MAXPATHLEN);
	header.name = (Bytef *) nameBuf;
	header.name_max = MAXPATHLEN - 1;
	commentBuf = ckalloc(MAX_COMMENT_LEN);
	commentBuf = (char *)ckalloc(MAX_COMMENT_LEN);
	header.comment = (Bytef *) commentBuf;
	header.comm_max = MAX_COMMENT_LEN - 1;
    }

    inData = Tcl_GetByteArrayFromObj(data, &inLen);
    if (bufferSize < 1) {
	/*
1916
1917
1918
1919
1920
1921
1922
1923

1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941

1942
1943
1944
1945
1946
1947
1948
1916
1917
1918
1919
1920
1921
1922

1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949







-
+


















+







 *	Implementation of the [zlib] command.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibCmd(
    void *notUsed,
    void *dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int command, dlen, i, option, level = -1;
    unsigned start, buffersize = 0;
    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",
	NULL
    };
    enum zlibCommands {
	CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
	CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
    };
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
	    &command) != TCL_OK) {
2517
2518
2519
2520
2521
2522
2523
2524

2525
2526
2527
2528
2529
2530
2531
2518
2519
2520
2521
2522
2523
2524

2525
2526
2527
2528
2529
2530
2531
2532







-
+







static int
ZlibStreamCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = cd;
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int command, count, code;
    Tcl_Obj *obj;
    static const char *const cmds[] = {
	"add", "checksum", "close", "eof", "finalize", "flush",
	"fullflush", "get", "header", "put", "reset",
	NULL
    };
2643
2644
2645
2646
2647
2648
2649
2650

2651
2652
2653
2654
2655
2656
2657
2644
2645
2646
2647
2648
2649
2650

2651
2652
2653
2654
2655
2656
2657
2658







-
+







static int
ZlibStreamAddCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = cd;
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int index, code, buffersize = -1, flush = -1, i;
    Tcl_Obj *obj, *compDictObj = NULL;
    static const char *const add_options[] = {
	"-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
    };
    enum addOptions {
	ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush
2767
2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2782







-
+







static int
ZlibStreamPutCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = cd;
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int index, flush = -1, i;
    Tcl_Obj *compDictObj = NULL;
    static const char *const put_options[] = {
	"-dictionary", "-finalize", "-flush", "-fullflush", NULL
    };
    enum putOptions {
	po_dictionary, po_finalize, po_flush, po_fullflush
2856
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
2870
2871







-
+







static int
ZlibStreamHeaderCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    ZlibStreamHandle *zshPtr = cd;
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd;
    Tcl_Obj *resultObj;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 2, objv, NULL);
	return TCL_ERROR;
    } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE
	    || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) {
2893
2894
2895
2896
2897
2898
2899
2900

2901
2902
2903
2904
2905
2906
2907
2894
2895
2896
2897
2898
2899
2900

2901
2902
2903
2904
2905
2906
2907
2908







-
+







 */

static int
ZlibTransformClose(
    void *instanceData,
    Tcl_Interp *interp)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    int e, written, result = TCL_OK;

    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);
2986
2987
2988
2989
2990
2991
2992
2993

2994
2995
2996
2997
2998
2999
3000
2987
2988
2989
2990
2991
2992
2993

2994
2995
2996
2997
2998
2999
3000
3001







-
+







static int
ZlibTransformInput(
    void *instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverInputProc *inProc =
	    Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
    int readBytes, gotBytes, copied;

    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
		errorCodePtr);
3100
3101
3102
3103
3104
3105
3106
3107

3108
3109
3110
3111
3112
3113
3114
3101
3102
3103
3104
3105
3106
3107

3108
3109
3110
3111
3112
3113
3114
3115







-
+







static int
ZlibTransformOutput(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverOutputProc *outProc =
	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
    int e, produced;
    Tcl_Obj *errObj;

    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
3221
3222
3223
3224
3225
3226
3227
3228

3229
3230
3231
3232
3233
3234
3235
3222
3223
3224
3225
3226
3227
3228

3229
3230
3231
3232
3233
3234
3235
3236







-
+







static int
ZlibTransformSetOption(			/* not used */
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverSetOptionProc *setOptionProc =
	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
    static const char *compressChanOptions = "dictionary flush";
    static const char *gzipChanOptions = "flush";
    static const char *decompressChanOptions = "dictionary limit";
    static const char *gunzipChanOptions = "flush limit";
    int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);
3334
3335
3336
3337
3338
3339
3340
3341

3342
3343
3344
3345
3346
3347
3348
3335
3336
3337
3338
3339
3340
3341

3342
3343
3344
3345
3346
3347
3348
3349







-
+







static int
ZlibTransformGetOption(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverGetOptionProc *getOptionProc =
	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
    static const char *compressChanOptions = "checksum dictionary";
    static const char *gzipChanOptions = "checksum";
    static const char *decompressChanOptions = "checksum dictionary limit";
    static const char *gunzipChanOptions = "checksum header limit";

3452
3453
3454
3455
3456
3457
3458
3459

3460
3461
3462
3463
3464
3465
3466
3453
3454
3455
3456
3457
3458
3459

3460
3461
3462
3463
3464
3465
3466
3467







-
+







 */

static void
ZlibTransformWatch(
    void *instanceData,
    int mask)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverWatchProc *watchProc;

    /*
     * This code is based on the code in tclIORTrans.c
     */

    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
3475
3476
3477
3478
3479
3480
3481
3482

3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502

3503
3504
3505
3506
3507
3508
3509
3476
3477
3478
3479
3480
3481
3482

3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502

3503
3504
3505
3506
3507
3508
3509
3510







-
+



















-
+







}

static int
ZlibTransformEventHandler(
    void *instanceData,
    int interestMask)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    ZlibTransformEventTimerKill(cd);
    return interestMask;
}

static inline void
ZlibTransformEventTimerKill(
    ZlibChannelData *cd)
{
    if (cd->timer != NULL) {
	Tcl_DeleteTimerHandler(cd->timer);
	cd->timer = NULL;
    }
}

static void
ZlibTransformTimerRun(
    void *clientData)
{
    ZlibChannelData *cd = clientData;
    ZlibChannelData *cd = (ZlibChannelData *)clientData;

    cd->timer = NULL;
    Tcl_NotifyChannel(cd->chan, TCL_READABLE);
}

/*
 *----------------------------------------------------------------------
3518
3519
3520
3521
3522
3523
3524
3525

3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545

3546
3547
3548
3549
3550
3551
3552
3519
3520
3521
3522
3523
3524
3525

3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545

3546
3547
3548
3549
3550
3551
3552
3553







-
+



















-
+








static int
ZlibTransformGetHandle(
    void *instanceData,
    int direction,
    void **handlePtr)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformBlockMode --
 *
 *	We need to keep track of the blocking mode; it changes our behavior.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformBlockMode(
    void *instanceData,
    int mode)
{
    ZlibChannelData *cd = instanceData;
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	cd->flags |= ASYNC;
    } else {
	cd->flags &= ~ASYNC;
    }
    return TCL_OK;
3588
3589
3590
3591
3592
3593
3594
3595

3596
3597
3598
3599
3600
3601
3602
3589
3590
3591
3592
3593
3594
3595

3596
3597
3598
3599
3600
3601
3602
3603







-
+







    Tcl_Obj *gzipHeaderDictPtr,	/* A description of header to use, or NULL to
				 * use a default. Ignored if not compressing
				 * to produce gzip-format data. */
    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
{
    ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
    ZlibChannelData *cd = (ZlibChannelData *)ckalloc(sizeof(ZlibChannelData));
    Tcl_Channel chan;
    int wbits = 0;

    if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
	Tcl_Panic("unknown mode: %d", mode);
    }

3648
3649
3650
3651
3652
3653
3654
3655

3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672

3673
3674
3675
3676
3677
3678
3679
3649
3650
3651
3652
3653
3654
3655

3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672

3673
3674
3675
3676
3677
3678
3679
3680







-
+
















-
+







     */

    if (mode == TCL_ZLIB_STREAM_INFLATE) {
	if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
	    goto error;
	}
	cd->inAllocated = DEFAULT_BUFFER_SIZE;
	cd->inBuffer = ckalloc(cd->inAllocated);
	cd->inBuffer = (char *)ckalloc(cd->inAllocated);
	if (cd->flags & IN_HEADER) {
	    if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
	    if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
		goto error;
	    }
	}
    } else {
	if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
	    goto error;
	}
	cd->outAllocated = DEFAULT_BUFFER_SIZE;
	cd->outBuffer = ckalloc(cd->outAllocated);
	cd->outBuffer = (char *)ckalloc(cd->outAllocated);
	if (cd->flags & OUT_HEADER) {
	    if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->compDictObj) {
	    if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {

Changes to libtommath/tommath_private.h.

190
191
192
193
194
195
196



197
198
199
200
201
202
203
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206







+
+
+







#define MP_MIN_PREC ((((int)MP_SIZEOF_BITS(uintmax_t) + MP_DIGIT_BIT) - 1) / MP_DIGIT_BIT)

MP_STATIC_ASSERT(prec_geq_min_prec, MP_PREC >= MP_MIN_PREC)

/* random number source */
extern MP_PRIVATE mp_err(*s_mp_rand_source)(void *out, size_t size);

#ifdef __cplusplus
extern "C" {
#endif
/* lowlevel functions, do not call! */
MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b);
MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
244
245
246
247
248
249
250




251
252
253
254
255
256
257
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264







+
+
+
+







      int redmode);
MP_DEPRECATED(s_mp_invmod_slow) mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_karatsuba_mul) mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_karatsuba_sqr) mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b);
MP_DEPRECATED(s_mp_toom_mul) mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_toom_sqr) mp_err mp_toom_sqr(const mp_int *a, mp_int *b);
MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len);

#ifdef __cplusplus
}
#endif

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#undef mp_sqr
#define mp_sqr TclBN_mp_sqr
#endif

#define MP_GET_ENDIANNESS(x) \

Changes to macosx/tclMacOSXBundle.c.

102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
102
103
104
105
106
107
108

109
110
111
112
113
114
115
116







-
+








    if (!initialized) {
#if TCL_DYLD_USE_DLFCN
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
	if (tclMacOSXDarwinRelease >= 8)
#endif
	{
	    openresourcemap = dlsym(RTLD_NEXT,
	    openresourcemap = (short (*)(CFBundleRef))dlsym(RTLD_NEXT,
		    "CFBundleOpenBundleResourceMap");
#ifdef TCL_DEBUG_LOAD
	    if (!openresourcemap) {
		const char *errMsg = dlerror();

		TclLoadDbgMsg("dlsym() failed: %s", errMsg);
	    }
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
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







-
+










+







 *	libraryVariableName may be set, and the resource file opened.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_MacOSXOpenVersionedBundleResources(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    const char *bundleName,
    const char *bundleVersion,
    int hasResourceFile,
    int maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;
    (void)dummy;

    libraryPath[0] = '\0';

    bundleNameRef = CFStringCreateWithCString(NULL, bundleName,
	    kCFStringEncodingUTF8);

    bundleRef = CFBundleGetBundleWithIdentifier(bundleNameRef);

Changes to macosx/tclMacOSXFCmd.c.

168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182







-
+







    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
	alist.fileattr = ATTR_FILE_RSRCLENGTH;
    } else {
	alist.commonattr = ATTR_CMN_FNDRINFO;
    }
    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read attributes of \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	return TCL_ERROR;
264
265
266
267
268
269
270
271

272
273
274
275
276
277
278
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278







-
+







    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
	alist.fileattr = ATTR_FILE_RSRCLENGTH;
    } else {
	alist.commonattr = ATTR_CMN_FNDRINFO;
    }
    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read attributes of \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	return TCL_ERROR;

Changes to macosx/tclMacOSXNotify.c.

854
855
856
857
858
859
860
861

862
863
864
865
866
867
868
854
855
856
857
858
859
860

861
862
863
864
865
866
867
868







-
+







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

void
Tcl_AlertNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;

    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    }

    LOCK_NOTIFIER_TSD;
941
942
943
944
945
946
947


948
949
950
951
952
953
954
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956







+
+







 */

static void
TimerWakeUp(
    CFRunLoopTimerRef timer,
    void *info)
{
    (void)timer;
    (void)info;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
 *
1032
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1048







-
+







    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = ckalloc(sizeof(FileHandler));
	filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	tsdPtr->firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
1376
1377
1378
1379
1380
1381
1382
1383

1384
1385
1386
1387
1388
1389
1390
1378
1379
1380
1381
1382
1383
1384

1385
1386
1387
1388
1389
1390
1391
1392







-
+








static void
QueueFileEvents(
    void *info)
{
    SelectMasks readyMasks;
    FileHandler *filePtr;
    ThreadSpecificData *tsdPtr = info;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;

    /*
     * Queue all detected file events.
     */

    LOCK_NOTIFIER_TSD;
    FD_COPY(&tsdPtr->readyMasks.readable, &readyMasks.readable);
1415
1416
1417
1418
1419
1420
1421
1422

1423
1424
1425
1426
1427
1428
1429
1417
1418
1419
1420
1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431







-
+








	/*
	 * Don't bother to queue an event if the mask was previously non-zero
	 * since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    FileHandlerEvent *fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
	    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent));

	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }
1448
1449
1450
1451
1452
1453
1454
1455


1456
1457
1458
1459
1460
1461
1462
1450
1451
1452
1453
1454
1455
1456

1457
1458
1459
1460
1461
1462
1463
1464
1465







-
+
+








static void
UpdateWaitingListAndServiceEvents(
    CFRunLoopObserverRef observer,
    CFRunLoopActivity activity,
    void *info)
{
    ThreadSpecificData *tsdPtr = info;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
    (void)observer;

    if (tsdPtr->sleeping) {
	return;
    }
    switch (activity) {
    case kCFRunLoopEntry:
	tsdPtr->runLoopNestingLevel++;
1823
1824
1825
1826
1827
1828
1829
1830

1831
1832
1833
1834
1835
1836

1837
1838
1839
1840
1841
1842
1843
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847







-
+






+







 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

static TCL_NORETURN void
NotifierThreadProc(
    ClientData clientData)	/* Not used. */
    ClientData dummy)	/* Not used. */
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask, writableMask, exceptionalMask;
    int i, numFdBits = 0, polling;
    struct timeval poll = {0., 0.}, *timePtr;
    char buf[2];
    (void)dummy;

    /*
     * Look for file events and report them to interested threads.
     */

    while (1) {
	FD_ZERO(&readableMask);

Changes to unix/configure.

5032
5033
5034
5035
5036
5037
5038
5039

5040
5041
5042
5043
5044
5045
5046
5032
5033
5034
5035
5036
5037
5038

5039
5040
5041
5042
5043
5044
5045
5046







-
+







    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    if test "$GCC" = yes; then :

	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wsign-compare -Wpointer-arith"

else

	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""

fi

Changes to unix/tcl.m4.

962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
962
963
964
965
966
967
968

969
970
971
972
973
974
975
976







-
+







    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"

Changes to unix/tclEpollNotfy.c.

12
13
14
15
16
17
18

19


20
21
22
23
24
25
26
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28







+
-
+
+







 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_EPOLL) && TCL_THREADS
#ifndef _GNU_SOURCE
#define _GNU_SOURCE		/* For pipe2(2) */
#   define _GNU_SOURCE		/* For pipe2(2) */
#endif
#include <fcntl.h>
#include <signal.h>
#include <sys/epoll.h>
#ifdef HAVE_EVENTFD
#include <sys/eventfd.h>
#endif /* HAVE_EVENTFD */
#include <sys/queue.h>
234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
236
237
238
239
240
241
242

243
244
245
246
247
248
249
250







-
+







    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	newEvent.events |= EPOLLIN;
    }
    if (filePtr->mask & TCL_WRITABLE) {
	newEvent.events |= EPOLLOUT;
    }
    if (isNew) {
        newPedPtr = ckalloc(sizeof(*newPedPtr));
        newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*
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
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







-
+




















-
+







    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    filePtr = ckalloc(sizeof(*filePtr));
    filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
#ifdef HAVE_EVENTFD
    tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
    if (tsdPtr->triggerEventFd <= 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
    }
    filePtr->fd = tsdPtr->triggerEventFd;
#else /* !HAVE_EVENTFD */
    if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    }
    filePtr->fd = tsdPtr->triggerPipe[0];
#endif /* HAVE_EVENTFD */
    tsdPtr->triggerFilePtr = filePtr;
    if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
	Tcl_Panic("epoll_create1: %s", strerror(errno));
    }
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(
	tsdPtr->readyEvents = (struct epoll_event *)ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
548
549
550
551
552
553
554

555
556
557
558
559
560
561
562







-
+







	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
729
730
731
732
733
734
735
736

737
738
739
740
741
742
743
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745







-
+








	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
768
769
770
771
772
773
774
775

776
777
778
779
780
781
782
770
771
772
773
774
775
776

777
778
779
780
781
782
783
784







-
+







	 * which in turn will cause PlatformEventsWait() to return
	 * immediately.
	 */

	numFound = PlatformEventsWait(tsdPtr->readyEvents,
		tsdPtr->maxReadyEvents, timeoutPtr);
	for (numEvent = 0; numEvent < numFound; numEvent++) {
	    pedPtr = tsdPtr->readyEvents[numEvent].data.ptr;
	    pedPtr = (struct PlatformEventData*)tsdPtr->readyEvents[numEvent].data.ptr;
	    filePtr = pedPtr->filePtr;
	    mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
#ifdef HAVE_EVENTFD
	    if (filePtr->fd == tsdPtr->triggerEventFd) {
		uint64_t eventFdVal;
		i = read(tsdPtr->triggerEventFd, &eventFdVal,
			sizeof(eventFdVal));
806
807
808
809
810
811
812
813

814
815
816
817
818
819
820
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822







-
+








	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;

Changes to unix/tclKqueueNotfy.c.

218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
218
219
220
221
222
223
224

225
226
227
228
229
230
231
232







-
+







{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = ckalloc(sizeof(*newPedPtr));
        newPedPtr = (struct PlatformEventData *)ckalloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
405
406
407
408
409
410
411
412

413
414
415
416
417
418

419
420
421
422
423
424
425
405
406
407
408
409
410
411

412
413
414
415
416
417

418
419
420
421
422
423
424
425







-
+





-
+







	}
    }
    if ((tsdPtr->eventsFd = kqueue()) == -1) {
	Tcl_Panic("kqueue: %s", strerror(errno));
    } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
	Tcl_Panic("fcntl: %s", strerror(errno));
    }
    filePtr = ckalloc(sizeof(*filePtr));
    filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
    filePtr->fd = tsdPtr->triggerPipe[0];
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = ckalloc(
	tsdPtr->readyEvents = (struct kevent *)ckalloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
576
577
578
579
580
581
582

583
584
585
586
587
588
589
590







-
+







	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
764
765
766
767
768
769
770
771

772
773
774
775
776
777
778
764
765
766
767
768
769
770

771
772
773
774
775
776
777
778







-
+








	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
824
825
826
827
828
829
830
831

832
833
834
835
836
837
838
824
825
826
827
828
829
830

831
832
833
834
835
836
837
838







-
+








	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask |= mask;

Changes to unix/tclLoadDl.c.

79
80
81
82
83
84
85
86

87
88
89
90
91
92
93
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93







-
+








    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    native = Tcl_FSGetNativePath(pathPtr);
    native = (const char *)Tcl_FSGetNativePath(pathPtr);
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     */
    if (flags & TCL_LOAD_GLOBAL) {
    	dlopenflags |= RTLD_GLOBAL;
    } else {
    	dlopenflags |= RTLD_LOCAL;
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141







-
+







	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't load file \"%s\": %s",
		    Tcl_GetString(pathPtr), errorStr));
	}
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;

    return TCL_OK;
184
185
186
187
188
189
190

























191
192
193
194
195
196
197
184
185
186
187
188
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
222







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
#ifdef __cplusplus
    if (proc == NULL) {
	char buf[32];
	sprintf(buf, "%d", Tcl_DStringLength(&ds));
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "__Z");
	Tcl_DStringAppend(&newName, buf, -1);
	Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), -1);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */
	if (proc == NULL) {
	    proc = dlsym(handle, native);	/* INTL: Native. */
	}
	if (proc == NULL) {
	    TclDStringAppendLiteral(&newName, "i");
	    native = Tcl_DStringValue(&newName);
	    proc = dlsym(handle, native + 1);	/* INTL: Native. */
	}
	if (proc == NULL) {
	    proc = dlsym(handle, native);	/* INTL: Native. */
	}
	Tcl_DStringFree(&newName);
    }
#endif
    Tcl_DStringFree(&ds);
    if (proc == NULL) {
	const char *errorStr = dlerror();

	if (interp) {
	    if (!errorStr) {
		errorStr = "unknown";
257
258
259
260
261
262
263


264
265
266
267
268
269
270
271
272
273
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300







+
+










int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    (void)fileName;
    (void)bufPtr;
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclLoadDyld.c.

179
180
181
182
183
184
185
186

187
188
189
190
191
192
193
179
180
181
182
183
184
185

186
187
188
189
190
191
192
193







-
+








    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativePath = Tcl_FSGetNativePath(pathPtr);
    nativePath = (const char *)Tcl_FSGetNativePath(pathPtr);
    nativeFileName = Tcl_UtfToExternalDString(NULL, Tcl_GetString(pathPtr),
	    -1, &ds);

#if TCL_DYLD_USE_DLFCN
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     */
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
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







-
+



















-
+





-
+







		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
    ) {
	dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle->dlHandle = dlHandle;
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	dyldLoadHandle->dyldLibHeader = dyldLibHeader;
	dyldLoadHandle->modulePtr = modulePtr;
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
	newHandle = ckalloc(sizeof(*newHandle));
	newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {
330
331
332
333
334
335
336
337

338
339
340
341
342
343
344
345
346

347
348
349
350
351
352
353
330
331
332
333
334
335
336

337
338
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353







-
+








-
+








static void *
FindSymbol(
    Tcl_Interp *interp,		/* For error reporting. */
    Tcl_LoadHandle loadHandle,	/* Handle from TclpDlopen. */
    const char *symbol)		/* Symbol name to look up. */
{
    Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData;
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
    Tcl_PackageInitProc *proc = NULL;
    const char *errMsg = NULL;
    Tcl_DString ds;
    const char *native;

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
	proc = dlsym(dyldLoadHandle->dlHandle, native);
	proc = (Tcl_PackageInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
	if (!proc) {
	    errMsg = dlerror();
	}
#endif /* TCL_DYLD_USE_DLFCN */
    } else {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	NSSymbol nsSymbol = NULL;
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
411
412
413
414

415
416
417
418
419
420
421
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
411
412
413

414
415
416
417
418
419
420
421







-
+

















-
+











-
+







		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr->module = module;
		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
		    dyldLoadHandle->modulePtr = modulePtr;
		}
#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
	    } else {
		NSLinkEditErrors editError;
		int errorNumber;
		const char *errorName;

		NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
	    }
	} else if (dyldLoadHandle->modulePtr) {
	    nsSymbol = NSLookupSymbolInModule(
		    dyldLoadHandle->modulePtr->module, native);
	}
	if (nsSymbol) {
	    proc = NSAddressOfSymbol(nsSymbol);
	    proc = (Tcl_PackageInitProc *)NSAddressOfSymbol(nsSymbol);
	}
	Tcl_DStringFree(&newName);
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_DStringFree(&ds);
    if (errMsg && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\": %s", symbol, errMsg));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
		NULL);
    }
    return proc;
    return (void *)proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 *
436
437
438
439
440
441
442
443

444
445
446
447
448
449
450
436
437
438
439
440
441
442

443
444
445
446
447
448
449
450







-
+








static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_DyldLoadHandle *dyldLoadHandle = loadHandle->clientData;
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;

    if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
	(void) dlclose(dyldLoadHandle->dlHandle);
#endif /* TCL_DYLD_USE_DLFCN */
    } else {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
487
488
489
490
491
492
493



494
495
496
497
498
499
500
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503







+
+
+







int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    (void)fileName;
    (void)bufPtr;

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemoryGetBuffer --
509
510
511
512
513
514
515
516

517
518
519

520
521
522
523
524
525
526
512
513
514
515
516
517
518

519
520
521
522
523
524
525
526
527
528
529
530







-
+



+







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

#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Interp *dummy,		/* Used for error reporting. */
    int size)			/* Size of desired buffer. */
{
    void *buffer = NULL;
    (void)dummy;

    /*
     * NSCreateObjectFileImageFromMemory is available but always fails
     * prior to Darwin 7.
     */
    if (tclMacOSXDarwinRelease >= 7) {
	/*
584
585
586
587
588
589
590
591

592
593
594
595
596
597
598
588
589
590
591
592
593
594

595
596
597
598
599
600
601
602







-
+








    /*
     * Try to create an object file image that we can load from.
     */

    if (codeSize >= 0) {
	NSObjectFileImageReturnCode err = NSObjectFileImageSuccess;
	const struct fat_header *fh = buffer;
	const struct fat_header *fh = (const struct fat_header *)buffer;
	uint32_t ms = 0;
#ifndef __LP64__
	const struct mach_header *mh = NULL;
#	define mh_size  sizeof(struct mach_header)
#	define mh_magic MH_MAGIC
#	define arch_abi 0
#else
613
614
615
616
617
618
619
620

621
622
623

624
625

626
627
628
629
630
631

632
633
634
635
636
637
638
639
640
641

642
643
644
645
646
647
648
617
618
619
620
621
622
623

624
625
626

627
628

629
630
631
632
633
634

635
636
637
638
639
640
641
642
643
644

645
646
647
648
649
650
651
652







-
+


-
+

-
+





-
+









-
+







	    if ((size_t) codeSize >= sizeof(struct fat_header) +
		    fh_nfat_arch * sizeof(struct fat_arch)) {
		void *fatarchs = (char*)buffer + sizeof(struct fat_header);
		const NXArchInfo *arch = NXGetLocalArchInfo();
		struct fat_arch *fa;

		if (fh->magic != FAT_MAGIC) {
		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
		    swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder);
		}
		fa = NXFindBestFatArch(arch->cputype | arch_abi,
			arch->cpusubtype, fatarchs, fh_nfat_arch);
			arch->cpusubtype, (struct fat_arch *)fatarchs, fh_nfat_arch);
		if (fa) {
		    mh = (void *)((char *) buffer + fa->offset);
		    mh = (const struct mach_header_64 *)((char *) buffer + fa->offset);
		    ms = fa->size;
		} else {
		    err = NSObjectFileImageInappropriateFile;
		}
		if (fh->magic != FAT_MAGIC) {
		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
		    swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder);
		}
	    } else {
		err = NSObjectFileImageInappropriateFile;
	    }
	} else {
	    /*
	     * Thin binary
	     */

	    mh = buffer;
	    mh = (const struct mach_header_64 *)buffer;
	    ms = codeSize;
	}
	if (ms && !(ms >= mh_size && mh->magic == mh_magic &&
		 mh->filetype == MH_BUNDLE)) {
	    err = NSObjectFileImageInappropriateFile;
	}
	if (err == NSObjectFileImageSuccess) {
689
690
691
692
693
694
695
696

697
698
699

700
701
702
703

704
705
706
707
708
709
710
693
694
695
696
697
698
699

700
701
702

703
704
705
706

707
708
709
710
711
712
713
714







-
+


-
+



-
+







	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = ckalloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr = (Tcl_DyldModuleHandle *)ckalloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = ckalloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle = (Tcl_DyldLoadHandle *)ckalloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle->dlHandle = NULL;
    dyldLoadHandle->dyldLibHeader = NULL;
    dyldLoadHandle->modulePtr = modulePtr;
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = dyldLoadHandle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}

Changes to unix/tclLoadNext.c.

97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
97
98
99
100
101
102
103

104
105
106
107
108
109
110
111







-
+







	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = ckalloc(sizeof(Tcl_LoadHandle));
    newHandle = (Tcl_LoadHandle) ckalloc(sizeof(*newHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;

    return TCL_OK;

Changes to unix/tclLoadOSF.c.

124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138







-
+







     */

    if ((pkg = strrchr(fileName, '/')) == NULL) {
        pkg = fileName;
    } else {
	pkg++;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}

Changes to unix/tclLoadShl.c.

93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107







-
+








    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    newHandle = ckalloc(sizeof(*newHandle));
    newHandle = (Tcl_LoadHandle)ckalloc(sizeof(*newHandle));
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}


Changes to unix/tclSelectNotfy.c.

206
207
208
209
210
211
212



213
214
215
216
217
218
219
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222







+
+
+







static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of critical bits of Windows API when building threaded with Cygwin.
 */

#if defined(__CYGWIN__)
#ifdef __cplusplus
extern "C" {
#endif
typedef struct {
    void *hwnd;			/* Messaging window. */
    unsigned int *message;	/* Message payload. */
    int wParam;			/* Event-specific "word" parameter. */
    int lParam;			/* Event-specific "long" parameter. */
    int time;			/* Event timestamp. */
    int x;			/* Event location (where meaningful). */
256
257
258
259
260
261
262
263

264
265



266
267
268
269
270
271
272
259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
278







-
+


+
+
+







extern unsigned char __stdcall	ResetEvent(void *);
extern unsigned char __stdcall	TranslateMessage(const MSG *);

/*
 * Threaded-cygwin specific constants and functions in this file:
 */

static const WCHAR className[] = L"TclNotifier";
static const wchar_t className[] = L"TclNotifier";
static DWORD __stdcall	NotifierProc(void *hwnd, unsigned int message,
			    void *wParam, void *lParam);
#ifdef __cplusplus
}
#endif
#endif /* TCL_THREADS && __CYGWIN__ */


#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
311
312
313
314










315
316
317
318



319
320
321
322
323
324
325
302
303
304
305
306
307
308

309
310










311
312
313
314
315
316
317
318
319
320
321



322
323
324
325
326
327
328
329
330
331







-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+







	tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
	    WNDCLASSW class;
	    WNDCLASSW clazz;

	    class.style = 0;
	    class.cbClsExtra = 0;
	    class.cbWndExtra = 0;
	    class.hInstance = TclWinGetTclInstance();
	    class.hbrBackground = NULL;
	    class.lpszMenuName = NULL;
	    class.lpszClassName = className;
	    class.lpfnWndProc = NotifierProc;
	    class.hIcon = NULL;
	    class.hCursor = NULL;
	    clazz.style = 0;
	    clazz.cbClsExtra = 0;
	    clazz.cbWndExtra = 0;
	    clazz.hInstance = TclWinGetTclInstance();
	    clazz.hbrBackground = NULL;
	    clazz.lpszMenuName = NULL;
	    clazz.lpszClassName = className;
	    clazz.lpfnWndProc = (void *)NotifierProc;
	    clazz.hIcon = NULL;
	    clazz.hCursor = NULL;

	    RegisterClassW(&class);
	    tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
		    class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
	    RegisterClassW(&clazz);
	    tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName,
		    clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
		    0 /* !signaled */, NULL);
#else
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
	    tsdPtr->waitCVinitialized = 1;
463
464
465
466
467
468
469
470

471
472
473
474
475
476
477
469
470
471
472
473
474
475

476
477
478
479
480
481
482
483







-
+







	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = ckalloc(sizeof(FileHandler));
	    filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
876
877
878
879
880
881
882
883

884
885
886
887
888
889
890
882
883
884
885
886
887
888

889
890
891
892
893
894
895
896







-
+







	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			ckalloc(sizeof(FileHandlerEvent));
			(FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
918
919
920
921
922
923
924
925

926
927
928
929
930
931
932
933
934

935
936

937
938
939
940
941
942
943
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938
939

940
941
942
943
944
945
946
947
948
949
950







-
+








-
+


+







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

#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
    ClientData clientData)	/* Not used. */
    ClientData dummy)	/* Not used. */
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;
    int i;
    int fds[2], receivePipe;
    long found;
    struct timeval poll = {0., 0.}, *timePtr;
    struct timeval poll = {0, 0}, *timePtr;
    char buf[2];
    int numFdBits = 0;
    (void)dummy;

    if (pipe(fds) != 0) {
	Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
    }

    receivePipe = fds[0];

Changes to unix/tclUnixChan.c.

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
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







-
-
+
+

-
-
-
+
+
+

-
+

-
+

-
+

-
+

-
+

-
+


-
+









-
+







	Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);		\
    }

/*
 * Static routines for this file:
 */

static int		FileBlockModeProc(ClientData instanceData, int mode);
static int		FileCloseProc(ClientData instanceData,
static int		FileBlockModeProc(void *instanceData, int mode);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp);
static int		FileGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		FileInputProc(ClientData instanceData, char *buf,
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(ClientData instanceData,
static int		FileOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static int		FileSeekProc(ClientData instanceData, long offset,
static int		FileSeekProc(void *instanceData, long offset,
			    int mode, int *errorCode);
static int		FileTruncateProc(ClientData instanceData,
static int		FileTruncateProc(void *instanceData,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
static Tcl_WideInt	FileWideSeekProc(void *instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileWatchProc(ClientData instanceData, int mask);
static void		FileWatchProc(void *instanceData, int mask);
#ifdef SUPPORTS_TTY
static int		TtyCloseProc(ClientData instanceData,
static int		TtyCloseProc(void *instanceData,
			    Tcl_Interp *interp);
static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtyGetOptionProc(ClientData instanceData,
static int		TtyGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TtyGetBaud(speed_t speed);
static speed_t		TtyGetSpeed(int baud);
static void		TtyInit(int fd);
static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);
static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
			    TtyAttrs *ttyPtr);
static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtySetOptionProc(ClientData instanceData,
static int		TtySetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
#endif	/* SUPPORTS_TTY */

/*
 * This structure describes the channel type structure for file based IO:
 */
221
222
223
224
225
226
227
228

229
230
231
232

233
234
235
236
237
238
239
221
222
223
224
225
226
227

228
229
230
231

232
233
234
235
236
237
238
239







-
+



-
+







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

	/* ARGSUSED */
static int
FileBlockModeProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be TCL_MODE_BLOCKING
				 * or TCL_MODE_NONBLOCKING. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;

    if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) {
	return errno;
    }

    return 0;
}
254
255
256
257
258
259
260
261

262
263
264
265
266
267

268
269
270
271
272
273
274
254
255
256
257
258
259
260

261
262
263
264
265
266

267
268
269
270
271
272
273
274







-
+





-
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileInputProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    int bytesRead;		/* How many bytes were actually read from the
				 * input device? */

    *errorCodePtr = 0;

    /*
     * Assume there is always enough input available. This will block
301
302
303
304
305
306
307
308

309
310
311
312
313

314
315
316
317
318
319
320
301
302
303
304
305
306
307

308
309
310
311
312

313
314
315
316
317
318
319
320







-
+




-
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileOutputProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    int written;

    *errorCodePtr = 0;

    if (toWrite == 0) {
	/*
	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
348
349
350
351
352
353
354
355
356


357
358

359

360
361
362
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
348
349
350
351
352
353
354


355
356
357

358
359
360
361
362
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







-
-
+
+

-
+

+




















-
+


-
+







 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileCloseProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
    void *instanceData,	/* File state. */
    Tcl_Interp *dummy)		/* For error reporting - unused. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    int errorCode = 0;
    (void)dummy;

    Tcl_DeleteFileHandler(fsPtr->fd);

    /*
     * Do not close standard channels while in thread-exit.
     */

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    ckfree(fsPtr);
    return errorCode;
}

#ifdef SUPPORTS_TTY
static int
TtyCloseProc(
    ClientData instanceData,
    void *instanceData,
    Tcl_Interp *interp)
{
    TtyState *ttyPtr = instanceData;
    TtyState *ttyPtr = (TtyState*)instanceData;

    /*
     * If we've been asked by the user to drain or flush, do so now.
     */

    switch (ttyPtr->closeMode) {
    case CLOSE_DRAIN:
431
432
433
434
435
436
437
438

439
440
441
442
443
444

445
446
447
448
449
450
451
432
433
434
435
436
437
438

439
440
441
442
443
444

445
446
447
448
449
450
451
452







-
+





-
+







 *	operations.
 *
 *----------------------------------------------------------------------
 */

static int
FileSeekProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_SET or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    Tcl_WideInt oldLoc, newLoc;

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
492
493
494
495
496
497
498
499

500
501
502
503
504
505

506
507
508
509
510
511
512
493
494
495
496
497
498
499

500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+





-
+







 *	operations.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_CUR or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    Tcl_WideInt newLoc;

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}
526
527
528
529
530
531
532
533

534
535
536
537
538

539
540
541
542
543
544
545
527
528
529
530
531
532
533

534
535
536
537
538

539
540
541
542
543
544
545
546







-
+




-
+







 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
FileWatchProc(
    ClientData instanceData,	/* The file state. */
    void *instanceData,	/* The file state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;

    /*
     * Make sure we only register for events that are valid on this file. Note
     * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler
     * with the channel pointer as the client data.
     */

568
569
570
571
572
573
574
575

576
577

578
579

580
581
582
583
584
585
586
569
570
571
572
573
574
575

576
577

578
579

580
581
582
583
584
585
586
587







-
+

-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileGetHandleProc(
    ClientData instanceData,	/* The file state. */
    void *instanceData,	/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
    void **handlePtr)	/* Where to store the handle. */
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}
635
636
637
638
639
640
641
642

643
644
645
646
647

648
649
650
651
652
653
654
636
637
638
639
640
641
642

643
644
645
646
647

648
649
650
651
652
653
654
655







-
+




-
+







 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtySetOptionProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    TtyState *fsPtr = instanceData;
    TtyState *fsPtr = (TtyState *)instanceData;
    unsigned int len, vlen;
    TtyAttrs tty;
    int argc;
    const char **argv;
    struct termios iostate;

    len = strlen(optionName);
974
975
976
977
978
979
980
981

982
983
984
985
986

987
988
989
990
991
992
993
975
976
977
978
979
980
981

982
983
984
985
986

987
988
989
990
991
992
993
994







-
+




-
+







 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtyGetOptionProc(
    ClientData instanceData,	/* File state. */
    void *instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    TtyState *fsPtr = instanceData;
    TtyState *fsPtr = (TtyState *)instanceData;
    unsigned int len;
    char buf[3*TCL_INTEGER_SPACE + 16];
    int valid = 0;		/* Flag if valid option parsed. */
    struct termios iostate;

    if (optionName == NULL) {
	len = 0;
1648
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661
1662
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661
1662
1663







-
+







	 * This may occurr if modeString was "", for example.
	 */

	Tcl_Panic("TclpOpenFileChannel: invalid mode value");
	return NULL;
    }

    native = Tcl_FSGetNativePath(pathPtr);
    native = (const char *)Tcl_FSGetNativePath(pathPtr);
    if (native == NULL) {
	if (interp != (Tcl_Interp *) NULL) {
	    Tcl_AppendResult(interp, "couldn't open \"",
	    TclGetString(pathPtr), "\": filename is invalid on this platform",
	    NULL);
	}
	return NULL;
1708
1709
1710
1711
1712
1713
1714
1715

1716
1717
1718
1719
1720
1721
1722
1709
1710
1711
1712
1713
1714
1715

1716
1717
1718
1719
1720
1721
1722
1723







-
+







#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = ckalloc(sizeof(TtyState));
    fsPtr = (TtyState *)ckalloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
	fsPtr->doReset = 0;
	tcgetattr(fsPtr->fileState.fd, &fsPtr->initState);
1759
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1774







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    ClientData handle,		/* OS level handle. */
    void *handle,		/* OS level handle. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
1786
1787
1788
1789
1790
1791
1792
1793

1794
1795
1796
1797
1798
1799

1800
1801
1802
1803
1804
1805
1806
1787
1788
1789
1790
1791
1792
1793

1794
1795
1796
1797
1798
1799

1800
1801
1802
1803
1804
1805
1806
1807







-
+





-
+







	sprintf(channelName, "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */
    if ((getsockname(fd, (struct sockaddr *) &sockaddr, &sockaddrLen) == 0)
	    && (sockaddrLen > 0)
	    && (sockaddr.sa_family == AF_INET
		    || sockaddr.sa_family == AF_INET6)) {
	return TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
    } else {
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = ckalloc(sizeof(TtyState));
    fsPtr = (TtyState *)ckalloc(sizeof(TtyState));
    fsPtr->fileState.fd = fd;
    fsPtr->fileState.validMask = mode | TCL_EXCEPTION;
    fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
1923
1924
1925
1926
1927
1928
1929
1930

1931
1932
1933
1934
1935

1936
1937
1938
1939
1940

1941

1942
1943
1944
1945
1946
1947
1948
1924
1925
1926
1927
1928
1929
1930

1931
1932
1933
1934
1935

1936
1937
1938
1939
1940

1941
1942
1943
1944
1945
1946
1947
1948
1949
1950







-
+




-
+




-
+

+








int
Tcl_GetOpenFile(
    Tcl_Interp *interp,		/* Interpreter in which to find file. */
    const char *chanID,		/* String that identifies file. */
    int forWriting,		/* 1 means the file is going to be used for
				 * writing, 0 means for reading. */
    int checkUsage,		/* 1 means verify that the file was opened in
    int dummy,		/* 1 means verify that the file was opened in
				 * a mode that allows the access specified by
				 * "forWriting". Ignored, we always check that
				 * the channel is open for the requested
				 * mode. */
    ClientData *filePtr)	/* Store pointer to FILE structure here. */
    void **filePtr)	/* Store pointer to FILE structure here. */
{
    Tcl_Channel chan;
    int chanMode, fd;
    const Tcl_ChannelType *chanTypePtr;
    ClientData data;
    void *data;
    FILE *f;
    (void)dummy;

    chan = Tcl_GetChannel(interp, chanID, &chanMode);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    if (forWriting && !(chanMode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
2018
2019
2020
2021
2022
2023
2024
2025

2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2020
2021
2022
2023
2024
2025
2026

2027
2028
2029

2030
2031
2032
2033
2034
2035
2036
2037







-
+


-
+







 *	places later in the file than the truncate point.
 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    ClientData instanceData,
    void *instanceData,
    Tcl_WideInt length)
{
    FileState *fsPtr = instanceData;
    FileState *fsPtr = (FileState *)instanceData;
    int result;

#ifdef HAVE_TYPE_OFF64_T
    /*
     * We assume this goes with the type for now...
     */

Changes to unix/tclUnixCompat.c.

114
115
116
117
118
119
120
121

122
123
124

125
126
127
128
129
130
131
114
115
116
117
118
119
120

121
122
123

124
125
126
127
128
129
130
131







-
+


-
+







static int		CopyHostent(struct hostent *tgtPtr, char *buf,
			    int buflen);
static int		CopyString(const char *src, char *buf, int buflen);

#endif

#ifdef NEED_PW_CLEANER
static void		FreePwBuf(ClientData ignored);
static void		FreePwBuf(ClientData dummy);
#endif
#ifdef NEED_GR_CLEANER
static void		FreeGrBuf(ClientData ignored);
static void		FreeGrBuf(ClientData dummy);
#endif
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --
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
222
223
224
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
222
223
224







-
+












-
+







     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
	tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
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
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







-
+












-
+







     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	tsdPtr->pbuf = (char *)ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
	tsdPtr->pbuf = (char *)ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
332
333
334
335
336
337
338
339

340
341

342
343
344
345
346
347
348
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346
347
348
349







-
+


+







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

#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
    ClientData ignored)
    ClientData dummy)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    ckfree(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
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
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







-
+












-
+







     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
	tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
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
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







-
+












-
+







     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	tsdPtr->gbuf = (char*)ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
	tsdPtr->gbuf = (char *)ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
515
516
517
518
519
520
521
522

523
524

525
526
527
528
529
530
531
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530
531
532
533







-
+


+







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

#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
    ClientData ignored)
    ClientData dummy)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    ckfree(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------

Changes to unix/tclUnixFCmd.c.

109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
109
110
111
112
113
114
115

116
117








118
119
120
121
122
123
124







-
+

-
-
-
-
-
-
-
-







 * Constants and variables necessary for file attributes subcommand.
 *
 * IMPORTANT: The permissions attribute is assumed to be the third item (i.e.
 * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly
 * elsewhere in Tcl's core.
 */

#ifdef DJGPP
#ifndef DJGPP

/*
 * See contrib/djgpp/tclDjgppFCmd.c for definition.
 */

extern TclFileAttrProcs tclpFileAttrProcs[];
extern const char *const tclpFileAttrStrings[];

#else /* !DJGPP */
enum {
#if defined(__CYGWIN__)
    UNIX_ARCHIVE_ATTRIBUTE,
#endif
    UNIX_GROUP_ATTRIBUTE,
#if defined(__CYGWIN__)
    UNIX_HIDDEN_ATTRIBUTE,
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
133
134
135
136
137
138
139

140
141
142
143
144
145
146







-







#ifdef MAC_OSX_TCL
    MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
    MACOSX_RSRCLENGTH_ATTRIBUTE,
#endif
    UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
};

MODULE_SCOPE const char *const tclpFileAttrStrings[];
const char *const tclpFileAttrStrings[] = {
#if defined(__CYGWIN__)
    "-archive",
#endif
    "-group",
#if defined(__CYGWIN__)
    "-hidden",
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
154
155
156
157
158
159
160

161
162
163
164
165
166
167







-







#endif
#ifdef MAC_OSX_TCL
    "-creator", "-type", "-hidden", "-rsrclength",
#endif
    NULL
};

MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
const TclFileAttrProcs tclpFileAttrProcs[] = {
#if defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
#endif
    {GetGroupAttribute, SetGroupAttribute},
#if defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
327
328
329
330
331
332
333
334
335


336
337
338
339
340
341
342
317
318
319
320
321
322
323


324
325
326
327
328
329
330
331
332







-
-
+
+







 */

int
TclpObjRenameFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
    return DoRenameFile((const char *)Tcl_FSGetNativePath(srcPathPtr),
	    (const char *)Tcl_FSGetNativePath(destPathPtr));
}

static int
DoRenameFile(
    const char *src,		/* Pathname of file or dir to be renamed
				 * (native). */
    const char *dst)		/* New pathname of file or directory
443
444
445
446
447
448
449
450

451
452
453
454
455
456
457

458
459
460
461
462
463
464
433
434
435
436
437
438
439

440
441
442
443
444
445
446

447
448
449
450
451
452
453
454







-
+






-
+







 */

int
TclpObjCopyFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    const char *src = Tcl_FSGetNativePath(srcPathPtr);
    const char *src = (const char *)Tcl_FSGetNativePath(srcPathPtr);
    Tcl_StatBuf srcStatBuf;

    if (TclOSlstat(src, &srcStatBuf) != 0) {		/* INTL: Native. */
	return TCL_ERROR;
    }

    return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
    return DoCopyFile(src, (const char *)Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
}

static int
DoCopyFile(
    const char *src,		/* Pathname of file to be copied (native). */
    const char *dst,		/* Pathname of file to copy to (native). */
    const Tcl_StatBuf *statBufPtr)
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
596
597
598
599
600
601
602

603
604
605
606
607
608
609
610







-
+







     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
    }
    buffer = ckalloc(blockSize);
    buffer = (char *)ckalloc(blockSize);
    while (1) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = (size_t) -1;
705
706
707
708
709
710
711
712

713
714
715
716
717
718
719
695
696
697
698
699
700
701

702
703
704
705
706
707
708
709







-
+







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

int
TclpObjCreateDirectory(
    Tcl_Obj *pathPtr)
{
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
    return DoCreateDirectory((const char *)Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    const char *path)		/* Pathname of directory to create (native). */
{
    mode_t mode;
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250



1251
1252
1253
1254
1255
1256
1257
1226
1227
1228
1229
1230
1231
1232

1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250







-
+







+
+
+







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

static int
TraversalDelete(
    Tcl_DString *srcPtr,	/* Source pathname (native). */
    Tcl_DString *ignore,	/* Destination pathname (not used). */
    Tcl_DString *dummy,	/* Destination pathname (not used). */
    const Tcl_StatBuf *statBufPtr,
				/* Stat info for file specified by srcPtr. */
    int type,			/* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    (void)dummy;
    (void)statBufPtr;

    switch (type) {
    case DOTREE_F:
	if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
	    return TCL_OK;
	}
	break;
    case DOTREE_PRED:
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299







+







    const char *src,		/* Path name of source file (native). */
    const char *dst,		/* Path name of target file (native). */
    const Tcl_StatBuf *statBufPtr)
				/* Stat info for source file */
{
    struct utimbuf tval;
    mode_t newMode;
    (void)src;

    newMode = statBufPtr->st_mode
	    & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);

    /*
     * Note that if you copy a setuid file that is owned by someone else, and
     * you are not root, then the copy will be setuid to you. The most correct
1350
1351
1352
1353
1354
1355
1356

1357
1358
1359
1360
1361
1362
1363
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct group *groupPtr;
    int result;
    (void)objIndex;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
1404
1405
1406
1407
1408
1409
1410

1411
1412
1413
1414
1415
1416
1417
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct passwd *pwPtr;
    int result;
    (void)objIndex;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467
1468
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465







+







    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    int objIndex,		    /* The index of the attribute. */
    Tcl_Obj *fileName,		    /* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;
    (void)objIndex;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    Tcl_WideInt gid;
    int result;
    const char *native;
    (void)objIndex;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);
1524
1525
1526
1527
1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1522
1523
1524
1525
1526
1527
1528

1529
1530
1531
1532
1533
1534
1535
1536







-
+







			"NO_GROUP", NULL);
	    }
	    return TCL_ERROR;
	}
	gid = groupPtr->gr_gid;
    }

    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) -1, (gid_t) gid);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set group for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    Tcl_WideInt uid;
    int result;
    const char *native;
    (void)objIndex;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;

	string = TclGetString(attributePtr);
1590
1591
1592
1593
1594
1595
1596
1597

1598
1599
1600
1601
1602
1603
1604
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
1603







-
+







			"NO_USER", NULL);
	    }
	    return TCL_ERROR;
	}
	uid = pwPtr->pw_uid;
    }

    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) uid, (gid_t) -1);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set owner for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
1633
1634
1635
1636
1637
1638
1639

1640
1641
1642
1643
1644
1645
1646
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646







+







{
    Tcl_WideInt mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);
    (void)objIndex;

    /*
     * First supply support for octal number format
     */

    if ((modeStringPtr[scanned] == '0')
	    && (modeStringPtr[scanned+1] >= '0')
1684
1685
1686
1687
1688
1689
1690
1691

1692
1693
1694
1695
1696
1697
1698
1684
1685
1686
1687
1688
1689
1690

1691
1692
1693
1694
1695
1696
1697
1698







-
+







			modeStringPtr));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = chmod(native, newMode);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set permissions for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}
1745
1746
1747
1748
1749
1750
1751
1752

1753
1754
1755
1756
1757
1758
1759
1760

1761
1762
1763
1764
1765
1766
1767
1745
1746
1747
1748
1749
1750
1751

1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768







-
+








+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
GetModeFromPermString(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    Tcl_Interp *dummy,		/* The interp we are using for errors. */
    const char *modeStringPtr, /* Permissions string */
    mode_t *modePtr)		/* pointer to the mode value */
{
    mode_t newMode;
    mode_t oldMode;		/* Storage for the value of the old mode (that
				 * is passed in), to allow for the chmod style
				 * manipulation. */
    int i,n, who, op, what, op_found, who_found;
    (void)dummy;

    /*
     * We start off checking for an "rwxrwxrwx" style permissions string
     */

    if (strlen(modeStringPtr) != 9) {
	goto chmodStyleCheck;
1932
1933
1934
1935
1936
1937
1938
1939

1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957

1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970

1971
1972
1973
1974
1975
1976
1977
1933
1934
1935
1936
1937
1938
1939

1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971

1972
1973
1974
1975
1976
1977
1978
1979







-
+


















+












-
+







 * Side effects:
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    Tcl_Obj *pathPtr,		/* An unshared object containing the path to
				 * normalize. */
    int nextCheckpoint)		/* offset to start at in pathPtr.  Must either
				 * be 0 or the offset of a directory separator
				 * at the end of a path part that is already
				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

{
    const char *currentPathEndPosition;
    char cur;
    const char *path = TclGetString(pathPtr);
    size_t pathLen = pathPtr->length;
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
#endif
    (void)dummy;

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }

#ifndef NO_REALPATH
    if (nextCheckpoint == 0 && haveRealpath) {
	/*
	 * Try to get the entire path in one go
	 */

	char *lastDir = strrchr(currentPathEndPosition, '/');
	const char *lastDir = strrchr(currentPathEndPosition, '/');

	if (lastDir != NULL) {
	    nativePath = Tcl_UtfToExternalDString(NULL, path,
		    lastDir-path, &ds);
	    if (Realpath(nativePath, normPath) != NULL) {
		if (*nativePath != '/' && *normPath == '/') {
		    /*
2165
2166
2167
2168
2169
2170
2171
2172

2173
2174
2175
2176
2177
2178
2179
2180
2181
2182

2183
2184
2185


2186
2187
2188

2189
2190
2191
2192
2193

2194
2195
2196

2197
2198
2199

2200
2201
2202
2203
2204
2205
2206


2207
2208
2209
2210
2211

2212
2213
2214
2215

2216
2217
2218
2219
2220
2221


2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232

2233
2234
2235

2236
2237
2238
2239
2240
2241
2242
2167
2168
2169
2170
2171
2172
2173

2174
2175
2176
2177
2178
2179
2180
2181
2182
2183

2184
2185


2186
2187
2188
2189

2190
2191
2192
2193
2194

2195
2196
2197

2198
2199
2200

2201
2202
2203
2204
2205
2206


2207
2208
2209
2210
2211
2212

2213
2214
2215
2216

2217
2218
2219
2220
2221


2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236

2237
2238
2239
2240
2241
2242
2243
2244







-
+









-
+

-
-
+
+


-
+




-
+


-
+


-
+





-
-
+
+




-
+



-
+




-
-
+
+










-
+


-
+







int
TclUnixOpenTemporaryFile(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_DString template, tmp;
    Tcl_DString templ, tmp;
    const char *string;
    int fd;

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    TclDStringAppendLiteral(&template, "/");
    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = TclGetString(basenameObj);
	Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
	TclDStringAppendDString(&template, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&template, "tcl");
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&template, "_XXXXXX");
    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = TclGetString(extensionObj);
	Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp);
	TclDStringAppendDString(&template, &tmp);
	fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&template));
	fd = mkstemp(Tcl_DStringValue(&templ));
    }

    if (fd == -1) {
	Tcl_DStringFree(&template);
	Tcl_DStringFree(&templ);
	return -1;
    }

    if (resultingNameObj) {
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
		Tcl_DStringLength(&template), &tmp);
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ),
		Tcl_DStringLength(&templ), &tmp);
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from
	 * this!
	 */

	unlink(Tcl_DStringValue(&template));
	unlink(Tcl_DStringValue(&templ));
	errno = 0;
    }
    Tcl_DStringFree(&template);
    Tcl_DStringFree(&templ);

    return fd;
}

/*
 * Helper that does *part* of what tempnam() does.
 */
2288
2289
2290
2291
2292
2293
2294
2295

2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307

2308
2309
2310


2311
2312
2313
2314


2315
2316
2317
2318
2319
2320
2321

2322
2323
2324

2325
2326
2327

2328
2329
2330

2331
2332
2333
2334
2335
2336
2337


2338
2339
2340
2341
2342
2343
2344
2345
2346
2347



2348
2349
2350
2351
2352
2353
2354
2290
2291
2292
2293
2294
2295
2296

2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308

2309
2310


2311
2312
2313
2314


2315
2316
2317
2318
2319
2320
2321
2322

2323
2324
2325

2326
2327
2328

2329
2330
2331

2332
2333
2334
2335
2336
2337


2338
2339
2340
2341
2342
2343
2344
2345
2346



2347
2348
2349
2350
2351
2352
2353
2354
2355
2356







-
+











-
+

-
-
+
+


-
-
+
+






-
+


-
+


-
+


-
+





-
-
+
+







-
-
-
+
+
+







 */

Tcl_Obj *
TclpCreateTemporaryDirectory(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj)
{
    Tcl_DString template, tmp;
    Tcl_DString templ, tmp;
    const char *string;

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"

    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ);
    } else {
	Tcl_DStringInit(&template);
	Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    if (Tcl_DStringValue(&template)[Tcl_DStringLength(&template) - 1] != '/') {
	TclDStringAppendLiteral(&template, "/");
    if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') {
	TclDStringAppendLiteral(&templ, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
	    TclDStringAppendDString(&template, &tmp);
	    TclDStringAppendDString(&templ, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX);
	    TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&template, DEFAULT_TEMP_DIR_PREFIX);
	TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
    }

    TclDStringAppendLiteral(&template, "_XXXXXX");
    TclDStringAppendLiteral(&templ, "_XXXXXX");

    /*
     * Make the temporary directory.
     */

    if (mkdtemp(Tcl_DStringValue(&template)) == NULL) {
	Tcl_DStringFree(&template);
    if (mkdtemp(Tcl_DStringValue(&templ)) == NULL) {
	Tcl_DStringFree(&templ);
	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
	    Tcl_DStringLength(&template), &tmp);
    Tcl_DStringFree(&template);
    Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), &tmp);
    Tcl_DStringFree(&templ);
    return TclDStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void
StatError(
2362
2363
2364
2365
2366
2367
2368
2369

2370
2371
2372
2373

2374
2375
2376
2377
2378
2379
2380
2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374

2375
2376
2377
2378
2379
2380
2381
2382







-
+



-
+







}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)
{
    int size;
    const char *native =  Tcl_FSGetNativePath(fileName);
    const char *native =  (const char *)Tcl_FSGetNativePath(fileName);
    WCHAR *winPath;

    size = cygwin_conv_path(1, native, NULL, 0);
    winPath = ckalloc(size);
    winPath = (WCHAR *)ckalloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4
2501
2502
2503
2504
2505
2506
2507

2508
2509
2510
2511
2512
2513
2514
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517







+







    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;
    (void)objIndex;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
2543
2544
2545
2546
2547
2548
2549

2550
2551
2552
2553
2554
2555
2556
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_StatBuf statBuf;
    int result, readonly;
    const char *native;
    (void)objIndex;

    if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
	return TCL_ERROR;
    }

    result = TclpObjStat(fileName, &statBuf);

2565
2566
2567
2568
2569
2570
2571
2572

2573
2574
2575
2576
2577
2578
2579
2569
2570
2571
2572
2573
2574
2575

2576
2577
2578
2579
2580
2581
2582
2583







-
+








    if (readonly) {
	statBuf.st_flags |= UF_IMMUTABLE;
    } else {
	statBuf.st_flags &= ~UF_IMMUTABLE;
    }

    native = Tcl_FSGetNativePath(fileName);
    native = (const char *)Tcl_FSGetNativePath(fileName);
    result = chflags(native, statBuf.st_flags);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set flags for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	}

Changes to unix/tclUnixFile.c.

40
41
42
43
44
45
46


47
48
49
50
51
52
53
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55







+
+







				 * (native). */
{
    Tcl_Encoding encoding;
#ifdef __CYGWIN__
    int length;
    wchar_t buf[PATH_MAX];
    char name[PATH_MAX * 3 + 1];
    (void)argv0;

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
245
246
247
248
249
250
251
252

253
254

255
256
257
258
259
260
261
247
248
249
250
251
252
253

254
255

256
257
258
259
260
261
262
263







-
+

-
+







	/*
	 * Match a file directly.
	 */

	Tcl_Obj *tailPtr;
	const char *nativeTail;

	native = Tcl_FSGetNativePath(pathPtr);
	native = (const char *)Tcl_FSGetNativePath(pathPtr);
	tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
	nativeTail = Tcl_FSGetNativePath(tailPtr);
	nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr);
	matchResult = NativeMatchType(interp, native, nativeTail, types);
	if (matchResult == 1) {
	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	}
	Tcl_DecrRefCount(tailPtr);
	Tcl_DecrRefCount(fileNamePtr);
    } else {
551
552
553
554
555
556
557


558
559
560
561
562
563
564
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568







+
+








	matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
		&buf, types);
	if (matchResult != 1) {
	    return matchResult;
	}
    }
#else
    (void)interp;
#endif /* MAC_OSX_TCL */

    return 1;
}

/*
 *---------------------------------------------------------------------------
618
619
620
621
622
623
624
625

626
627
628
629
630
631
632
622
623
624
625
626
627
628

629
630
631
632
633
634
635
636







-
+







 */

int
TclpObjAccess(
    Tcl_Obj *pathPtr,		/* Path of file to access */
    int mode)			/* Permission setting. */
{
    const char *path = Tcl_FSGetNativePath(pathPtr);
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return access(path, mode);
}

646
647
648
649
650
651
652
653

654
655
656
657
658
659
660
650
651
652
653
654
655
656

657
658
659
660
661
662
663
664







-
+







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

int
TclpObjChdir(
    Tcl_Obj *pathPtr)		/* Path to new working directory */
{
    const char *path = Tcl_FSGetNativePath(pathPtr);
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return chdir(path);
}

675
676
677
678
679
680
681
682

683
684
685
686
687
688
689
679
680
681
682
683
684
685

686
687
688
689
690
691
692
693







-
+







 */

int
TclpObjLstat(
    Tcl_Obj *pathPtr,		/* Path of file to stat */
    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
{
    return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
    return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetNativeCwd --
 *
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







-
+







#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = ckalloc(strlen(buffer) + 1);
	char *newCd = (char*)ckalloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
    }

    /*
     * No change to pwd.
843
844
845
846
847
848
849
850

851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867

868
869
870
871
872
873
874
847
848
849
850
851
852
853

854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870

871
872
873
874
875
876
877
878







-
+
















-
+







 */

int
TclpObjStat(
    Tcl_Obj *pathPtr,		/* Path of file to stat */
    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
{
    const char *path = Tcl_FSGetNativePath(pathPtr);
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return TclOSstat(path, bufPtr);
}

#ifdef S_IFLNK

Tcl_Obj *
TclpObjLink(
    Tcl_Obj *pathPtr,
    Tcl_Obj *toPtr,
    int linkAction)
{
    if (toPtr != NULL) {
	const char *src = Tcl_FSGetNativePath(pathPtr);
	const char *src = (const char *)Tcl_FSGetNativePath(pathPtr);
	const char *target = NULL;

	if (src == NULL) {
	    return NULL;
	}

	/*
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
910
911
912
913
914
915
916

917
918
919
920
921
922
923
924







-
+







	    /*
	     * Target exists; we'll construct the relative path we want below.
	     */

	    Tcl_DecrRefCount(absPtr);
	    Tcl_DecrRefCount(dirPtr);
	} else {
	    target = Tcl_FSGetNativePath(toPtr);
	    target = (const char*)Tcl_FSGetNativePath(toPtr);
	    if (target == NULL) {
		return NULL;
	    }
	    if (access(target, F_OK) == -1) {
		/*
		 * Target doesn't exist.
		 */
978
979
980
981
982
983
984
985

986
987
988
989
990
991
992
982
983
984
985
986
987
988

989
990
991
992
993
994
995
996







-
+








	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    return NULL;
	}
	Tcl_DecrRefCount(transPtr);

	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
	linkPtr = TclDStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
1014
1015
1016
1017
1018
1019
1020

1021
1022
1023
1024
1025
1026
1027
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032







+







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

Tcl_Obj *
TclpFilesystemPathType(
    Tcl_Obj *pathPtr)
{
    (void)pathPtr;
    /*
     * All native paths are of the same type.
     */

    return NULL;
}

1112
1113
1114
1115
1116
1117
1118
1119

1120
1121
1122
1123
1124
1125
1126
1117
1118
1119
1120
1121
1122
1123

1124
1125
1126
1127
1128
1129
1130
1131







-
+







    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
	/* See bug [3118489]: NUL in filenames */
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = ckalloc(len);
    nativePathPtr = (char *)ckalloc(len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
}

/*
1153
1154
1155
1156
1157
1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1158
1159
1160
1161
1162
1163
1164

1165
1166
1167
1168
1169
1170
1171
1172







-
+








    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);

    copy = ckalloc(len);
    copy = (char *)ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
1179
1180
1181
1182
1183
1184
1185
1186

1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

1198
1199
1200
1201
1202
1203
1204
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1209







-
+










-
+







 */

int
TclpUtime(
    Tcl_Obj *pathPtr,		/* File to modify */
    struct utimbuf *tval)	/* New modification date structure */
{
    return utime(Tcl_FSGetNativePath(pathPtr), tval);
    return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval);
}

#ifdef __CYGWIN__

int
TclOSstat(
    const char *name,
    void *cygstat)
{
    struct stat buf;
    Tcl_StatBuf *statBuf = cygstat;
    Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
    int result = stat(name, &buf);

    statBuf->st_mode = buf.st_mode;
    statBuf->st_ino = buf.st_ino;
    statBuf->st_dev = buf.st_dev;
    statBuf->st_rdev = buf.st_rdev;
    statBuf->st_nlink = buf.st_nlink;
1213
1214
1215
1216
1217
1218
1219
1220

1221
1222
1223
1224
1225
1226
1227
1218
1219
1220
1221
1222
1223
1224

1225
1226
1227
1228
1229
1230
1231
1232







-
+








int
TclOSlstat(
    const char *name,
    void *cygstat)
{
    struct stat buf;
    Tcl_StatBuf *statBuf = cygstat;
    Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;
    int result = lstat(name, &buf);

    statBuf->st_mode = buf.st_mode;
    statBuf->st_ino = buf.st_ino;
    statBuf->st_dev = buf.st_dev;
    statBuf->st_rdev = buf.st_rdev;
    statBuf->st_nlink = buf.st_nlink;

Changes to unix/tclUnixInit.c.

27
28
29
30
31
32
33



34
35
36
37
38
39
40
41



42
43
44
45
46
47
48
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







+
+
+








+
+
+







#   include <sys/param.h>
#   if _BSDI_VERSION > 199501
#	include <dlfcn.h>
#   endif
#endif

#ifdef __CYGWIN__
#ifdef __cplusplus
extern "C" {
#endif
#ifdef __clang__
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *);
DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *);
DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);
#ifdef __cplusplus
}
#endif

#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
};

536
537
538
539
540
541
542
543

544
545
546
547
548
549
550
542
543
544
545
546
547
548

549
550
551
552
553
554
555
556







-
+







	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetString(pathPtr);
    *lengthPtr = pathPtr->length;
    *valuePtr = ckalloc(*lengthPtr + 1);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
1055
1056
1057
1058
1059
1060
1061




1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084







+
+
+
+













{
    int foundInFramework = TCL_ERROR;

#ifdef TCL_FRAMEWORK
    foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
	    "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen,
	    tclLibPath);
#else
    (void)interp;
    (void)maxPathLen;
    (void)tclLibPath;
#endif

    return foundInFramework;
}
#endif /* HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixNotfy.c.

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
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







-
+












-
+







{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = clientData;
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
	pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
#else /* !NOTIFIER_SELECT */
	ThreadSpecificData *tsdPtr = clientData;
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
#if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD)
	uint64_t eventFdVal = 1;
	if (write(tsdPtr->triggerEventFd, &eventFdVal,
		sizeof(eventFdVal)) != sizeof(eventFdVal)) {
	    Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd",
		(void *)tsdPtr);
	}

Changes to unix/tclUnixPipe.c.

44
45
46
47
48
49
50
51
52


53
54
55
56



57
58

59
60

61
62
63
64
65
66
67
44
45
46
47
48
49
50


51
52
53



54
55
56
57

58
59

60
61
62
63
64
65
66
67







-
-
+
+

-
-
-
+
+
+

-
+

-
+







				 * the children at close time. */
} PipeState;

/*
 * Declarations for local functions defined in this file:
 */

static int		PipeBlockModeProc(ClientData instanceData, int mode);
static int		PipeClose2Proc(ClientData instanceData,
static int		PipeBlockModeProc(void *instanceData, int mode);
static int		PipeClose2Proc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		PipeGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		PipeInputProc(ClientData instanceData, char *buf,
static int		PipeGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		PipeInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		PipeOutputProc(ClientData instanceData,
static int		PipeOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		PipeWatchProc(ClientData instanceData, int mask);
static void		PipeWatchProc(void *instanceData, int mask);
static void		RestoreSignals(void);
static int		SetupStdFile(TclFile file, int type);

/*
 * This structure describes the channel type structure for command pipe based
 * I/O:
 */
103
104
105
106
107
108
109
110

111
112
113
114
115
116
117
103
104
105
106
107
108
109

110
111
112
113
114
115
116
117







-
+







 */

TclFile
TclpMakeFile(
    Tcl_Channel channel,	/* Channel to get file from. */
    int direction)		/* Either TCL_READABLE or TCL_WRITABLE. */
{
    ClientData data;
    void *data;

    if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) {
	return NULL;
    }

    return MakeFile(PTR2INT(data));
}
267
268
269
270
271
272
273

274
275
276
277
278
279
280
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281







+








Tcl_Obj *
TclpTempFileNameForLibrary(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *path)		/* Path name of the library in the VFS. */
{
    Tcl_Obj *retval = TclpTempFileName();
    (void)path;

    if (retval == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't create temporary file: %s",
		Tcl_PosixError(interp)));
    }
    return retval;
428
429
430
431
432
433
434
435
436


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


436
437
438
439
440
441
442
443
444







-
-
+
+







    }

    /*
     * We need to allocate and convert this before the fork so it is properly
     * deallocated later
     */

    dsArray = TclStackAlloc(interp, argc * sizeof(Tcl_DString));
    newArgv = TclStackAlloc(interp, (argc+1) * sizeof(char *));
    dsArray = (Tcl_DString *)TclStackAlloc(interp, argc * sizeof(Tcl_DString));
    newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *));
    newArgv[argc] = NULL;
    for (i = 0; i < argc; i++) {
	newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
    }

#ifdef USE_VFORK
    /*
740
741
742
743
744
745
746
747

748
749
750
751
752
753
754
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755







-
+







    Tcl_Pid *pidPtr)		/* An array of process identifiers. Allocated
				 * by the caller, freed when the channel is
				 * closed or the processes are detached (in a
				 * background exec). */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    int channelId;
    PipeState *statePtr = ckalloc(sizeof(PipeState));
    PipeState *statePtr = (PipeState *)ckalloc(sizeof(PipeState));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;
809
810
811
812
813
814
815

816
817
818
819
820
821
822
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824







+







Tcl_CreatePipe(
    Tcl_Interp *interp,		/* Errors returned in result. */
    Tcl_Channel *rchan,		/* Returned read side. */
    Tcl_Channel *wchan,		/* Returned write side. */
    int flags)			/* Reserved for future use. */
{
    int fileNums[2];
    (void)flags;

    if (pipe(fileNums) < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
		Tcl_PosixError(interp)));
	return TCL_ERROR;
    }

865
866
867
868
869
870
871
872

873
874
875
876
877
878
879
867
868
869
870
871
872
873

874
875
876
877
878
879
880
881







-
+







     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
	return;
    }

    pipePtr = Tcl_GetChannelInstanceData(chan);
    pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
899
900
901
902
903
904
905
906

907
908
909
910
911

912
913
914
915
916
917
918
901
902
903
904
905
906
907

908
909
910
911
912

913
914
915
916
917
918
919
920







-
+




-
+







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

	/* ARGSUSED */
static int
PipeBlockModeProc(
    ClientData instanceData,	/* Pipe state. */
    void *instanceData,	/* Pipe state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeState *psPtr = instanceData;
    PipeState *psPtr = (PipeState *)instanceData;

    if (psPtr->inFile
	    && TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) {
	return errno;
    }
    if (psPtr->outFile
	    && TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) {
939
940
941
942
943
944
945
946

947
948
949
950

951
952
953
954
955
956
957
941
942
943
944
945
946
947

948
949
950
951

952
953
954
955
956
957
958
959







-
+



-
+







 *	Closes the command pipeline channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeClose2Proc(
    ClientData instanceData,	/* The pipe to close. */
    void *instanceData,	/* The pipe to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    PipeState *pipePtr = instanceData;
    PipeState *pipePtr = (PipeState *)instanceData;
    Tcl_Channel errChan;
    int errorCode, result;

    errorCode = 0;
    result = 0;

    if (((!flags) || (flags & TCL_CLOSE_READ)) && (pipePtr->inFile != NULL)) {
1034
1035
1036
1037
1038
1039
1040
1041

1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056







-
+





-
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeInputProc(
    ClientData instanceData,	/* Pipe state. */
    void *instanceData,	/* Pipe state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = instanceData;
    PipeState *psPtr = (PipeState *)instanceData;
    int bytesRead;		/* How many bytes were actually read from the
				 * input device? */

    *errorCodePtr = 0;

    /*
     * Assume there is always enough input available. This will block
1085
1086
1087
1088
1089
1090
1091
1092

1093
1094
1095
1096
1097

1098
1099
1100
1101
1102
1103
1104
1087
1088
1089
1090
1091
1092
1093

1094
1095
1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106







-
+




-
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeOutputProc(
    ClientData instanceData,	/* Pipe state. */
    void *instanceData,	/* Pipe state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = instanceData;
    PipeState *psPtr = (PipeState *)instanceData;
    int written;

    *errorCodePtr = 0;

    /*
     * Some OSes can throw an interrupt error, for which we should immediately
     * retry. [Bug #415131]
1130
1131
1132
1133
1134
1135
1136
1137

1138
1139
1140
1141
1142

1143
1144
1145
1146
1147
1148
1149
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143

1144
1145
1146
1147
1148
1149
1150
1151







-
+




-
+







 *	seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
PipeWatchProc(
    ClientData instanceData,	/* The pipe state. */
    void *instanceData,	/* The pipe state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    PipeState *psPtr = instanceData;
    PipeState *psPtr = (PipeState *)instanceData;
    int newmask;

    if (psPtr->inFile) {
	newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
	if (newmask) {
	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask,
		    (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
1178
1179
1180
1181
1182
1183
1184
1185

1186
1187

1188
1189

1190
1191
1192
1193
1194
1195
1196
1180
1181
1182
1183
1184
1185
1186

1187
1188

1189
1190

1191
1192
1193
1194
1195
1196
1197
1198







-
+

-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PipeGetHandleProc(
    ClientData instanceData,	/* The pipe state. */
    void *instanceData,	/* The pipe state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
    void **handlePtr)	/* Where to store the handle. */
{
    PipeState *psPtr = instanceData;
    PipeState *psPtr = (PipeState *)instanceData;

    if (direction == TCL_READABLE && psPtr->inFile) {
	*handlePtr = INT2PTR(GetFd(psPtr->inFile));
	return TCL_OK;
    }
    if (direction == TCL_WRITABLE && psPtr->outFile) {
	*handlePtr = INT2PTR(GetFd(psPtr->outFile));
1248
1249
1250
1251
1252
1253
1254
1255

1256
1257
1258
1259
1260
1261
1262
1263

1264
1265
1266
1267
1268
1269
1270
1250
1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273







-
+








+







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

	/* ARGSUSED */
int
Tcl_PidObjCmd(
    ClientData dummy,		/* Not used. */
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    PipeState *pipePtr;
    int i;
    Tcl_Obj *resultPtr;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }

    if (objc == 1) {
1282
1283
1284
1285
1286
1287
1288
1289

1290
1291
1292
1293
1294
1295
1296
1285
1286
1287
1288
1289
1290
1291

1292
1293
1294
1295
1296
1297
1298
1299







-
+







	    return TCL_OK;
	}

	/*
	 * Extract the process IDs from the pipe structure.
	 */

	pipePtr = Tcl_GetChannelInstanceData(chan);
	pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }

Changes to unix/tclUnixPort.h.

83
84
85
86
87
88
89



90
91
92
93
94
95
96
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99







+
+
+







typedef off_t		Tcl_SeekOffset;
#   define TclOSseek		lseek
#   define TclOSopen		open
#endif

#ifdef __CYGWIN__

#ifdef __cplusplus
extern "C" {
#endif
    /* Make some symbols available without including <windows.h> */
#   define DWORD unsigned int
#   define CP_UTF8 65001
#   define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
#   define HANDLE void *
#   define HINSTANCE void *
#   define SOCKET unsigned int
120
121
122
123
124
125
126



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







+
+
+







#ifndef __x86_64__
#   define environ __cygwin_environ
    extern char **__cygwin_environ;
#endif
#   define timezone _timezone
    extern int TclOSstat(const char *name, void *statBuf);
    extern int TclOSlstat(const char *name, void *statBuf);
#ifdef __cplusplus
}
#endif
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
#   define TclOSstat		stat64
#   define TclOSlstat		lstat64
#else
#   define TclOSstat		stat
#   define TclOSlstat		lstat
#endif

Changes to unix/tclUnixSock.c.

62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76







-
+








    /*
     * Only needed for server sockets
     */

    Tcl_TcpAcceptProc *acceptProc;
                                /* Proc to call on accept. */
    ClientData acceptProcData;  /* The data for the accept proc. */
    void *acceptProcData;  /* The data for the accept proc. */

    /*
     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
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
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







-
-
-
+
+
+

-
+

-
-
-
+
+
+


-
+

-
+

-
+

-
+







#define SOCKET_BUFSIZE	4096

/*
 * Static routines for this file:
 */

static int		TcpConnect(Tcl_Interp *interp, TcpState *state);
static void		TcpAccept(ClientData data, int mask);
static int		TcpBlockModeProc(ClientData data, int mode);
static int		TcpCloseProc(ClientData instanceData,
static void		TcpAccept(void *data, int mask);
static int		TcpBlockModeProc(void *data, int mode);
static int		TcpCloseProc(void *instanceData,
			    Tcl_Interp *interp);
static int		TcpClose2Proc(ClientData instanceData,
static int		TcpClose2Proc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		TcpGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TcpGetOptionProc(ClientData instanceData,
static int		TcpGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		TcpGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
static int		TcpInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
static int		TcpOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		TcpWatchProc(ClientData instanceData, int mask);
static void		TcpWatchProc(void *instanceData, int mask);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static void		WrapNotify(ClientData clientData, int mask);
static void		WrapNotify(void *clientData, int mask);

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */

static const Tcl_ChannelType tcpChannelType = {
235
236
237
238
239
240
241
242

243
244
245
246
247
248
249
235
236
237
238
239
240
241

242
243
244
245
246
247
248
249







-
+







	     * as it exceeds SYS_NMLN. See if we can just get the immediate
	     * nodename and get a proper answer that way.
	     */

	    char *dot = strchr(u.nodename, '.');

	    if (dot != NULL) {
		char *node = ckalloc(dot - u.nodename + 1);
		char *node = (char *)ckalloc(dot - u.nodename + 1);

		memcpy(node, u.nodename, dot - u.nodename);
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		ckfree(node);
	    }
	}
279
280
281
282
283
284
285
286

287
288
289
290

291
292
293
294
295
296
297
279
280
281
282
283
284
285

286
287
288
289

290
291
292
293
294
295
296
297







-
+



-
+







	native = buffer;
    }
#endif /* NO_UNAME */

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    if (native) {
	*lengthPtr = strlen(native);
	*valuePtr = ckalloc(*lengthPtr + 1);
	*valuePtr = (char *)ckalloc(*lengthPtr + 1);
	memcpy(*valuePtr, native, *lengthPtr + 1);
    } else {
	*lengthPtr = 0;
	*valuePtr = ckalloc(1);
	*valuePtr = (char *)ckalloc(1);
	*valuePtr[0] = '\0';
    }
}

/*
 * ----------------------------------------------------------------------
 *
330
331
332
333
334
335
336
337

338


339
340
341
342
343
344
345
330
331
332
333
334
335
336

337
338
339
340
341
342
343
344
345
346
347







-
+

+
+







 *	None.
 *
 * ----------------------------------------------------------------------
 */

int
TclpHasSockets(
    Tcl_Interp *interp)		/* Not used. */
    Tcl_Interp *dummy)		/* Not used. */
{
    (void)dummy;

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
377
378
379
380
381
382
383
384

385
386
387
388
389

390
391
392
393
394
395
396
379
380
381
382
383
384
385

386
387
388
389
390

391
392
393
394
395
396
397
398







-
+




-
+







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

	/* ARGSUSED */
static int
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    void *instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
523
524
525
526
527
528
529
530

531
532
533
534
535
536

537
538
539
540
541
542
543
525
526
527
528
529
530
531

532
533
534
535
536
537

538
539
540
541
542
543
544
545







-
+





-
+







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

	/* ARGSUSED */
static int
TcpInputProc(
    ClientData instanceData,	/* Socket state. */
    void *instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    bytesRead = recv(statePtr->fds.fd, buf, (size_t) bufSize, 0);
574
575
576
577
578
579
580
581

582
583
584
585
586

587
588
589
590
591
592
593
576
577
578
579
580
581
582

583
584
585
586
587

588
589
590
591
592
593
594
595







-
+




-
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    ClientData instanceData,	/* Socket state. */
    void *instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int written;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    written = send(statePtr->fds.fd, buf, (size_t) toWrite, 0);
616
617
618
619
620
621
622
623
624


625
626

627
628

629
630
631
632
633
634
635
618
619
620
621
622
623
624


625
626
627

628
629
630
631
632
633
634
635
636
637
638







-
-
+
+

-
+


+







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

	/* ARGSUSED */
static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
    void *instanceData,	/* The socket to close. */
    Tcl_Interp *dummy)		/* For error reporting - unused. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int errorCode = 0;
    TcpFdList *fds;
    (void)dummy;

    /*
     * Delete a file handler that may be active for this socket if this is a
     * server socket - the file handler was created automatically by Tcl as
     * part of the mechanism to accept new client connections. Channel
     * handlers are already deleted in the generic IO channel closing code
     * that called this function, so we do not have to delete them here.
677
678
679
680
681
682
683
684

685
686
687
688

689
690
691
692
693
694
695
680
681
682
683
684
685
686

687
688
689
690

691
692
693
694
695
696
697
698







-
+



-
+







 *	Shuts down one side of the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    void *instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;

    /*
     * Shutdown the OS socket handle.
     */
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
828
829
830
831
832
833
834
835

836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
831
832
833
834
835
836
837

838
839
840
841
842
843
844
845

846
847
848
849
850
851
852
853







-
+







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    ClientData instanceData,	/* Socket state. */
    void *instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    size_t len = 0;

    WaitForConnect(statePtr, NULL);

    if (optionName != NULL) {
	len = strlen(optionName);
    }
994
995
996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
997
998
999
1000
1001
1002
1003

1004
1005
1006
1007
1008
1009
1010
1011







-
+







 *	seen by Tcl.
 *
 * ----------------------------------------------------------------------
 */

static void
WrapNotify(
    ClientData clientData,
    void *clientData,
    int mask)
{
    TcpState *statePtr = (TcpState *) clientData;
    int newmask = mask & statePtr->interest;

    if (newmask == 0) {
	/*
1023
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037

1038
1039
1040
1041
1042
1043
1044
1045







-
+




-
+







	newmask = TCL_WRITABLE;
    }
    Tcl_NotifyChannel(statePtr->channel, newmask);
}

static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    void *instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;

    if (statePtr->acceptProc != NULL) {
        /*
         * Make sure we don't mess with server sockets since they will never
         * be readable or writable at the Tcl level. This keeps Tcl scripts
         * from interfering with the -accept behavior (bug #3394732).
         */
1097
1098
1099
1100
1101
1102
1103
1104

1105
1106

1107
1108


1109
1110
1111
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
1100
1101
1102
1103
1104
1105
1106

1107
1108

1109
1110

1111
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







-
+

-
+

-
+
+



















-
+




+
+
-
+







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

	/* ARGSUSED */
static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    void *instanceData,	/* The socket state. */
    int direction,		/* Not used. */
    ClientData *handlePtr)	/* Where to store the handle. */
    void **handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    (void)direction;

    *handlePtr = INT2PTR(statePtr->fds.fd);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpAsyncCallback --
 *
 *	Called by the event handler that TcpConnect sets up internally for
 *	[socket -async] to get notified when the asynchronous connection
 *	attempt has succeeded or failed.
 *
 * ----------------------------------------------------------------------
 */

static void
TcpAsyncCallback(
    ClientData clientData,	/* The socket state. */
    void *clientData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    (void)mask;

    TcpConnect(NULL, clientData);
    TcpConnect(NULL, (TcpState *)clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpConnect --
 *
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
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







+










-







    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    TcpState *statePtr)
{
    socklen_t optlen;
    int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
    int ret = -1, error = EHOSTUNREACH;
    int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    static const int reuseaddr = 1;

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
            statePtr->addr = statePtr->addr->ai_next) {
        for (statePtr->myaddr = statePtr->myaddrlist;
                statePtr->myaddr != NULL;
                statePtr->myaddr = statePtr->myaddr->ai_next) {
            int reuseaddr = 1;

	    /*
	     * No need to try combinations of local and remote addresses of
	     * different families.
	     */

	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
1385
1386
1387
1388
1389
1390
1391
1392

1393
1394
1395
1396
1397
1398
1399
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1405







-
+







        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = ckalloc(sizeof(TcpState));
    statePtr = (TcpState *)ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;

1432
1433
1434
1435
1436
1437
1438
1439

1440
1441
1442
1443
1444
1445
1446
1438
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1452







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    ClientData sock)		/* The socket to wrap up into a channel. */
    void *sock)		/* The socket to wrap up into a channel. */
{
    return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock,
            TCL_READABLE | TCL_WRITABLE);
}

/*
 *----------------------------------------------------------------------
1464
1465
1466
1467
1468
1469
1470
1471

1472
1473
1474
1475
1476
1477
1478
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483
1484







-
+







    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = ckalloc(sizeof(TcpState));
    statePtr = (TcpState *)ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
1507
1508
1509
1510
1511
1512
1513
1514

1515
1516
1517
1518
1519
1520
1521
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527







-
+







    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    ClientData acceptProcData)	/* Data for the callback. */
    void *acceptProcData)	/* Data for the callback. */
{
    int status = 0, sock = -1, optvalue, port, chosenport;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
    TcpState *statePtr = NULL;
    char channelName[SOCK_CHAN_LENGTH];
    const char *errorMsg = NULL;
    TcpFdList *fds = NULL, *newfds;
1687
1688
1689
1690
1691
1692
1693
1694

1695
1696
1697
1698
1699
1700
1701

1702
1703
1704
1705
1706
1707
1708
1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704
1705
1706

1707
1708
1709
1710
1711
1712
1713
1714







-
+






-
+







            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = ckalloc(sizeof(TcpState));
            statePtr = (TcpState *)ckalloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
            newfds = &statePtr->fds;
        } else {
            newfds = ckalloc(sizeof(TcpFdList));
            newfds = (TcpFdList *)ckalloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;

1755
1756
1757
1758
1759
1760
1761
1762

1763
1764
1765

1766
1767
1768
1769
1770
1771

1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786

1787
1788
1789
1790
1791
1792
1793
1761
1762
1763
1764
1765
1766
1767

1768
1769
1770

1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792

1793
1794
1795
1796
1797
1798
1799
1800







-
+


-
+






+














-
+







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

	/* ARGSUSED */
static void
TcpAccept(
    ClientData data,		/* Callback token. */
    void *data,		/* Callback token. */
    int mask)			/* Not used. */
{
    TcpFdList *fds = data;	/* Client data of server socket. */
    TcpFdList *fds = (TcpFdList *)data;	/* Client data of server socket. */
    int newsock;		/* The new client socket */
    TcpState *newSockState;	/* State for new socket. */
    address addr;		/* The remote address */
    socklen_t len;		/* For accept interface */
    char channelName[SOCK_CHAN_LENGTH];
    char host[NI_MAXHOST], port[NI_MAXSERV];
    (void)mask;

    len = sizeof(addr);
    newsock = accept(fds->fd, &addr.sa, &len);
    if (newsock < 0) {
	return;
    }

    /*
     * Set close-on-exec flag to prevent the newly accepted socket from being
     * inherited by child processes.
     */

    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = ckalloc(sizeof(TcpState));
    newSockState = (TcpState *)ckalloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);

Changes to unix/tclUnixTest.c.

125
126
127
128
129
130
131
132

133
134
135
136
137
138
139
140
141

142
143
144
145
146
147
148
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







-
+









+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilehandlerCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Pipe *pipePtr;
    int i, mask, timeout;
    static int initialized = 0;
    char buffer[4000];
    TclFile file;
    (void)dummy;

    /*
     * NOTE: When we make this code work on Windows also, the following
     * variable needs to be made Unix-only.
     */

    if (!initialized) {
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325







-
+








static void
TestFileHandlerProc(
    ClientData clientData,	/* Points to a Pipe structure. */
    int mask)			/* Indicates which events happened:
				 * TCL_READABLE or TCL_WRITABLE. */
{
    Pipe *pipePtr = clientData;
    Pipe *pipePtr = (Pipe *)clientData;

    if (mask & TCL_READABLE) {
	pipePtr->readCount++;
    }
    if (mask & TCL_WRITABLE) {
	pipePtr->writeCount++;
    }
339
340
341
342
343
344
345
346

347
348
349
350
351
352
353
354

355
356
357
358
359
360
361
340
341
342
343
344
345
346

347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363







-
+








+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilewaitCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    int mask, result, timeout;
    Tcl_Channel channel;
    int fd;
    ClientData data;
    (void)dummy;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout");
	return TCL_ERROR;
    }
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    if (channel == NULL) {
407
408
409
410
411
412
413
414

415
416
417
418
419

420
421
422
423
424
425
426
409
410
411
412
413
414
415

416
417
418
419
420
421
422
423
424
425
426
427
428
429







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfindexecutableCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Obj *saveName;
    (void)dummy;

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

    saveName = TclGetObjNameOfExecutable();
449
450
451
452
453
454
455
456

457
458
459
460
461

462
463
464
465
466
467
468
452
453
454
455
456
457
458

459
460
461
462
463
464
465
466
467
468
469
470
471
472







-
+





+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestforkCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    pid_t pid;
    (void)dummy;

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "");
        return TCL_ERROR;
    }
    pid = fork();
    if (pid == -1) {
495
496
497
498
499
500
501
502

503
504
505
506
507
508
509

510
511
512
513
514
515
516
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521







-
+







+







 *	Sets up an signal and async handlers.
 *
 *----------------------------------------------------------------------
 */

static int
TestalarmCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
#ifdef SA_RESTART
    unsigned int sec = 1;
    struct sigaction action;
    (void)dummy;

    if (objc > 1) {
	Tcl_GetIntFromObj(interp, objv[1], (int *)&sec);
    }

    /*
     * Setup the signal handling that automatically retries any interrupted
524
525
526
527
528
529
530


531
532
533
534
535
536
537
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544







+
+







    if (sigaction(SIGALRM, &action, NULL) < 0) {
	Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }
    (void) alarm(sec);
    return TCL_OK;
#else
    (void)dummy;

    Tcl_AppendResult(interp,
	    "warning: sigaction SA_RESTART not support on this platform",
	    NULL);
    return TCL_ERROR;
#endif
}

551
552
553
554
555
556
557


558
559
560
561
562
563
564
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573







+
+







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

static void
AlarmHandler(
    int signum)
{
    (void)signum;

    gotsig = "1";
}

/*
 *----------------------------------------------------------------------
 *
 * TestgotsigCmd --
572
573
574
575
576
577
578
579

580
581
582
583




584
585
586
587
588
589
590
581
582
583
584
585
586
587

588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603







-
+




+
+
+
+







 *	Resets the value of gotsig back to '0'.
 *
 *----------------------------------------------------------------------
 */

static int
TestgotsigCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    (void)dummy;
    (void)objc;
    (void)objv;

    Tcl_AppendResult(interp, gotsig, NULL);
    gotsig = "0";
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
609
610
611
612
613
614
615

616
617
618
619
620
621
622
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636







+







TestchmodCmd(
    ClientData dummy,			/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    int i, mode;
    (void)dummy;

    if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {

Changes to unix/tclUnixThrd.c.

573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
573
574
575
576
577
578
579

580
581
582
583
584
585
586
587







-
+







    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&masterLock);
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = ckalloc(sizeof(PMutex));
	    pmutexPtr = (PMutex *)ckalloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
683
684
685
686
687
688
689

690
691
692
693
694
695
696
697







-
+








	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = ckalloc(sizeof(pthread_cond_t));
	    pcondPtr = (pthread_cond_t *)ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&masterLock);
    }
    pmutexPtr = *((PMutex **) mutexPtr);
842
843
844
845
846
847
848
849

850
851
852
853
854
855
856
842
843
844
845
846
847
848

849
850
851
852
853
854
855
856







-
+








Tcl_Mutex *
TclpNewAllocMutex(void)
{
    AllocMutex *lockPtr;
    PMutex *plockPtr;

    lockPtr = malloc(sizeof(AllocMutex));
    lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    PMutexInit(&lockPtr->plock);
    return &lockPtr->tlock;
913
914
915
916
917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936

937
938
939
940
941
942
943
944
945
946
947
948
949
950

951
952
953
954
955
956
957
958
959
960
961

962
963
964
965
966
967
968
969
970
971
972
973
974
913
914
915
916
917
918
919

920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935

936
937
938
939
940
941
942
943
944
945
946
947
948
949

950
951
952
953
954
955
956
957
958
959
960

961
962
963
964
965
966
967
968
969
970
971
972
973
974







-
+















-
+













-
+










-
+













#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = TclpSysAlloc(sizeof(pthread_key_t), 0);
    ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t), 0);
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }

    return ptkeyPtr;
}

void
TclpThreadDeleteKey(
    void *keyPtr)
{
    pthread_key_t *ptkeyPtr = keyPtr;
    pthread_key_t *ptkeyPtr = (pthread_key_t *)keyPtr;

    if (pthread_key_delete(*ptkeyPtr)) {
	Tcl_Panic("unable to delete key!");
    }

    TclpSysFree(keyPtr);
}

void
TclpThreadSetMasterTSD(
    void *tsdKeyPtr,
    void *ptr)
{
    pthread_key_t *ptkeyPtr = tsdKeyPtr;
    pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;

    if (pthread_setspecific(*ptkeyPtr, ptr)) {
	Tcl_Panic("unable to set master TSD value");
    }
}

void *
TclpThreadGetMasterTSD(
    void *tsdKeyPtr)
{
    pthread_key_t *ptkeyPtr = tsdKeyPtr;
    pthread_key_t *ptkeyPtr = (pthread_key_t*)tsdKeyPtr;

    return pthread_getspecific(*ptkeyPtr);
}

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

Changes to unix/tclUnixTime.c.

54
55
56
57
58
59
60
61

62
63
64
65
66
67
68
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68







-
+








/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
ClientData tclTimeClientData = NULL;
void *tclTimeClientData = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclpGetSeconds --
 *
 *	This procedure returns the number of seconds from the epoch. On most
507
508
509
510
511
512
513


514
515
516
517
518
519
520
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522







+
+







 */

static void
NativeScaleTime(
    Tcl_Time *timePtr,
    ClientData clientData)
{
    (void)timePtr;
    (void)clientData;
    /* Native scale is 1:1. Nothing is done */
}

/*
 *----------------------------------------------------------------------
 *
 * NativeGetTime --
530
531
532
533
534
535
536
537

538
539

540
541
542
543
544
545
546
532
533
534
535
536
537
538

539
540
541
542
543
544
545
546
547
548
549







-
+


+







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

static void
NativeGetTime(
    Tcl_Time *timePtr,
    ClientData clientData)
    ClientData dummy)
{
    struct timeval tv;
    (void)dummy;

    (void) gettimeofday(&tv, NULL);
    timePtr->sec = tv.tv_sec;
    timePtr->usec = tv.tv_usec;
}
/*
 *----------------------------------------------------------------------
574
575
576
577
578
579
580
581

582
583
584
585
586
587
588
577
578
579
580
581
582
583

584
585
586
587
588
589
590
591







-
+







    if (lastTZ == NULL || strcmp(lastTZ, newTZ)) {
	tzset();
	if (lastTZ == NULL) {
	    Tcl_CreateExitHandler(CleanupMemory, NULL);
	} else {
	    ckfree(lastTZ);
	}
	lastTZ = ckalloc(strlen(newTZ) + 1);
	lastTZ = (char *)ckalloc(strlen(newTZ) + 1);
	strcpy(lastTZ, newTZ);
    }
    Tcl_MutexUnlock(&tmMutex);
}

/*
 *----------------------------------------------------------------------
599
600
601
602
603
604
605
606

607

608
609
610
611
612
613
614
615
616
617
618
602
603
604
605
606
607
608

609
610
611
612
613
614
615
616
617
618
619
620
621
622







-
+

+











 *	Frees allocated memory.
 *
 *----------------------------------------------------------------------
 */

static void
CleanupMemory(
    ClientData ignored)
    ClientData dummy)
{
    (void)dummy;
    ckfree(lastTZ);
}
#endif /* TCL_NO_DEPRECATED */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclXtNotify.c.

355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369







-
+







    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = ckalloc(sizeof(FileHandler));
	filePtr = (FileHandler *)ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->read = 0;
	filePtr->write = 0;
	filePtr->except = 0;
	filePtr->readyMask = 0;
	filePtr->mask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;
521
522
523
524
525
526
527
528

529
530
531
532
533
534
535
521
522
523
524
525
526
527

528
529
530
531
532
533
534
535







-
+







    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    fileEvPtr = ckalloc(sizeof(FileHandlerEvent));
    fileEvPtr = (FileHandlerEvent *)ckalloc(sizeof(FileHandlerEvent));
    fileEvPtr->header.proc = FileHandlerEventProc;
    fileEvPtr->fd = filePtr->fd;
    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);

    /*
     * Process events on the Tcl event queue before returning to Xt.
     */

Changes to win/configure.

4213
4214
4215
4216
4217
4218
4219
4220

4221
4222
4223
4224
4225
4226
4227
4228
4229

4230
4231
4232
4233
4234
4235
4236
4213
4214
4215
4216
4217
4218
4219

4220
4221
4222
4223
4224
4225
4226
4227
4228

4229
4230
4231
4232
4233
4234
4235
4236







-
+








-
+







	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wsign-compare -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement"
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement -Wstrict-prototypes"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \$@"
	CC_EXENAME="-o \$@"

Changes to win/tcl.m4.

681
682
683
684
685
686
687
688

689
690
691
692
693
694
695
696
697

698
699
700
701
702
703
704
681
682
683
684
685
686
687

688
689
690
691
692
693
694
695
696

697
698
699
700
701
702
703
704







-
+








-
+







	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wextra -Wwrite-strings -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement"
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wdeclaration-after-statement -Wstrict-prototypes"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \[$]@"
	CC_EXENAME="-o \[$]@"

Changes to win/tclAppInit.c.

86
87
88
89
90
91
92


93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109







+
+






-

+







#ifdef TCL_BROKEN_MAINARGS
int
main(
    int argc,			/* Number of command-line arguments. */
    char *dummy[])		/* Not used. */
{
    TCHAR **argv;
    TCHAR *p;
    (void)dummy;
#else
int
_tmain(
    int argc,			/* Number of command-line arguments. */
    TCHAR *argv[])		/* Values of command-line arguments. */
{
#endif
    TCHAR *p;
#endif

    /*
     * Set up the default locale to be standard "C" locale so parsing is
     * performed correctly.
     */

    setlocale(LC_ALL, "C");
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
269
270
271
272
273
274
275

276
277
278
279
280
281
282
283







-
+







	}
    }

    /* Make sure we don't call ckalloc through the (not yet initialized) stub table */
#   undef Tcl_Alloc
#   undef Tcl_DbCkalloc

    argSpace = ckalloc(size * sizeof(char *)
    argSpace = (TCHAR *)ckalloc(size * sizeof(char *)
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {

Changes to win/tclWin32Dll.c.

115
116
117
118
119
120
121


122
123
124
125
126
127
128
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130







+
+








BOOL APIENTRY
DllMain(
    HINSTANCE hInst,		/* Library instance handle. */
    DWORD reason,		/* Reason this function is being called. */
    LPVOID reserved)		/* Not used. */
{
    (void)reserved;

    switch (reason) {
    case DLL_PROCESS_ATTACH:
	DisableThreadLibraryCalls(hInst);
	TclWinInit(hInst);
	return TRUE;

	/*
381
382
383
384
385
386
387
388
389


390
391
392
393
394
395
396
383
384
385
386
387
388
389


390
391
392
393
394
395
396
397
398







-
-
+
+







		    dlIter = dlIter->nextPtr) {
		if (wcscmp(dlIter->volumeName, Target) == 0) {
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = ckalloc(sizeof(MountPointMap));
		dlPtr2->volumeName = TclNativeDupInternalRep(Target);
		dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
	    }
	}
    }

407
408
409
410
411
412
413
414
415


416
417
418
419
420
421
422
409
410
411
412
413
414
415


416
417
418
419
420
421
422
423
424







-
-
+
+







    }

    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = ckalloc(sizeof(MountPointMap));
    dlPtr2->volumeName = TclNativeDupInternalRep((ClientData) mountPoint);
    dlPtr2 = (MountPointMap *)ckalloc(sizeof(MountPointMap));
    dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((ClientData) mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}


Changes to win/tclWinChan.c.

176
177
178
179
180
181
182
183

184


185
186
187
188
189
190
191
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190
191
192
193







-
+

+
+







 *	Destroys the communication window.
 *
 *----------------------------------------------------------------------
 */

static void
FileChannelExitHandler(
    ClientData clientData)	/* Old window proc */
    ClientData dummy)	/* Old window proc */
{
    (void)dummy;

    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * FileSetupProc --
200
201
202
203
204
205
206
207

208
209
210
211
212

213
214
215
216
217
218
219
202
203
204
205
206
207
208

209
210
211
212
213
214
215
216
217
218
219
220
221
222







-
+





+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
FileSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    FileInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready file. If so, poll.
243
244
245
246
247
248
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
246
247
248
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







-
+





+














-
+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
FileCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    FileEvent *evPtr;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready files that don't already have events queued
     * (caused by persistent states that won't generate WinSock events).
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
	    SET_FLAG(infoPtr->flags, FILE_PENDING);
	    evPtr = ckalloc(sizeof(FileEvent));
	    evPtr = (FileEvent *)ckalloc(sizeof(FileEvent));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

346
347
348
349
350
351
352
353

354
355
356
357
358
359
360
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364







-
+








static int
FileBlockProc(
    ClientData instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;

    /*
     * Files on Windows can not be switched between blocking and nonblocking,
     * hence we have to emulate the behavior. This is done in the input
     * function by checking against a bit in the state. We set or unset the
     * bit here to cause the input function to emulate the correct behavior.
     */
382
383
384
385
386
387
388
389

390
391

392
393
394

395
396
397
398
399
400
401
386
387
388
389
390
391
392

393
394

395
396
397
398
399
400
401
402
403
404
405
406







-
+

-
+



+







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

static int
FileCloseProc(
    ClientData instanceData,	/* Pointer to FileInfo structure. */
    Tcl_Interp *interp)		/* Not used. */
    Tcl_Interp *dummy)		/* Not used. */
{
    FileInfo *fileInfoPtr = instanceData;
    FileInfo *fileInfoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr;
    int errorCode = 0;
    (void)dummy;

    /*
     * Remove the file from the watch list.
     */

    FileWatchProc(instanceData, 0);

459
460
461
462
463
464
465
466

467
468
469
470
471
472
473
464
465
466
467
468
469
470

471
472
473
474
475
476
477
478







-
+







static int
FileSeekProc(
    ClientData instanceData,	/* File state. */
    long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? */
    int *errorCodePtr)		/* To store error code. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    LONG newPos, newPosHigh, oldPos, oldPosHigh;
    DWORD moveMethod;

    *errorCodePtr = 0;
    if (mode == SEEK_SET) {
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
537
538
539
540
541
542
543
544

545
546
547
548
549
550
551
542
543
544
545
546
547
548

549
550
551
552
553
554
555
556







-
+







static Tcl_WideInt
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? */
    int *errorCodePtr)		/* To store error code. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD moveMethod;
    LONG newPos, newPosHigh;

    *errorCodePtr = 0;
    if (mode == SEEK_SET) {
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
592
593
594
595
596
597
598

599
600
601
602
603
604
605
606







-
+







 */

static int
FileTruncateProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt length)		/* Length to truncate at. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    LONG newPos, newPosHigh, oldPos, oldPosHigh;

    /*
     * Save where we were...
     */

    oldPosHigh = 0;
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
670
671
672
673
674
675
676

677
678
679
680
681
682
683
684







-
+







static int
FileInputProc(
    ClientData instanceData,	/* File state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* Num bytes available in buffer. */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD bytesRead;

    *errorCode = 0;

    /*
     * TODO: This comment appears to be out of date. We *do* have a console
     * driver, over in tclWinConsole.c. After some Windows developer confirms,
720
721
722
723
724
725
726
727

728
729
730
731
732
733
734
725
726
727
728
729
730
731

732
733
734
735
736
737
738
739







-
+







static int
FileOutputProc(
    ClientData instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    DWORD bytesWritten;

    *errorCode = 0;

    /*
     * If we are writing to a file that was opened with O_APPEND, we need to
     * seek to the end of the file before writing the current buffer.
767
768
769
770
771
772
773
774

775
776
777
778
779
780
781
772
773
774
775
776
777
778

779
780
781
782
783
784
785
786







-
+







static void
FileWatchProc(
    ClientData instanceData,	/* File state. */
    int mask)			/* What events to watch for; OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;
    Tcl_Time blockTime = { 0, 0 };

    /*
     * Since the file is always ready for events, we set the block time to
     * zero so we will poll.
     */

805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
810
811
812
813
814
815
816

817
818
819
820
821
822
823
824







-
+








static int
FileGetHandleProc(
    ClientData instanceData,	/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle.  */
{
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;

    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
850
851
852
853
854
855
856
857

858
859
860
861
862
863
864
855
856
857
858
859
860
861

862
863
864
865
866
867
868
869







-
+







    int channelPermissions = 0;
    DWORD accessMode = 0, createMode, shareMode, flags;
    const WCHAR *nativeName;
    HANDLE handle;
    char channelName[16 + TCL_INTEGER_SPACE];
    TclFile readFile = NULL, writeFile = NULL;

    nativeName = Tcl_FSGetNativePath(pathPtr);
    nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    if (nativeName == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open \"%s\": filename is invalid on this platform",
		    TclGetString(pathPtr)));
	}
	return NULL;
1361
1362
1363
1364
1365
1366
1367
1368

1369
1370
1371
1372
1373
1374
1375
1366
1367
1368
1369
1370
1371
1372

1373
1374
1375
1376
1377
1378
1379
1380







-
+







    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = ckalloc(sizeof(FileInfo));
    infoPtr = (FileInfo *)ckalloc(sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

1452
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462
1463
1464
1465
1466
1457
1458
1459
1460
1461
1462
1463

1464
1465
1466
1467
1468
1469
1470
1471







-
+








static void
FileThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileInfo *infoPtr = instanceData;
    FileInfo *infoPtr = (FileInfo *)instanceData;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	infoPtr->nextPtr = tsdPtr->firstFilePtr;
	tsdPtr->firstFilePtr = infoPtr;
    } else {
	FileInfo **nextPtrPtr;
	int removed = 0;

Changes to win/tclWinConsole.c.

313
314
315
316
317
318
319
320

321


322
323
324
325
326
327
328
313
314
315
316
317
318
319

320
321
322
323
324
325
326
327
328
329
330







-
+

+
+







 *	Removes the console event source.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleExitHandler(
    ClientData clientData)	/* Old window proc. */
    ClientData dummy)	/* Old window proc. */
{
    (void)dummy;

    Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * ProcExitHandler --
337
338
339
340
341
342
343
344

345


346
347
348
349
350
351
352
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353
354
355
356







-
+

+
+







 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    ClientData clientData)	/* Old window proc. */
    ClientData dummy)	/* Old window proc. */
{
    (void)dummy;

    Tcl_MutexLock(&consoleMutex);
    initialized = 0;
    Tcl_MutexUnlock(&consoleMutex);
}

/*
 *----------------------------------------------------------------------
363
364
365
366
367
368
369
370

371
372
373
374
375
376

377
378
379
380
381
382
383
367
368
369
370
371
372
373

374
375
376
377
378
379
380
381
382
383
384
385
386
387
388







-
+






+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
ConsoleSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Look to see if any events are already pending. If they are, poll.
417
418
419
420
421
422
423
424

425
426
427
428
429

430
431
432
433
434
435
436
422
423
424
425
426
427
428

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







-
+





+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleInfo *infoPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready consoles that don't already have events
458
459
460
461
462
463
464
465

466
467
468
469
470
471
472
464
465
466
467
468
469
470

471
472
473
474
475
476
477
478







-
+







	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		needEvent = 1;
	    }
	}

	if (needEvent) {
	    ConsoleEvent *evPtr = ckalloc(sizeof(ConsoleEvent));
	    ConsoleEvent *evPtr = (ConsoleEvent *)ckalloc(sizeof(ConsoleEvent));

	    infoPtr->flags |= CONSOLE_PENDING;
	    evPtr->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
490
491
492
493
494
495
496
497

498
499
500
501
502
503
504
496
497
498
499
500
501
502

503
504
505
506
507
508
509
510







-
+








static int
ConsoleBlockModeProc(
    ClientData instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;

    /*
     * Consoles on Windows can not be switched between blocking and
     * nonblocking, hence we have to emulate the behavior. This is done in the
     * input function by checking against a bit in the state. We set or unset
     * the bit here to cause the input function to emulate the correct
     * behavior.
527
528
529
530
531
532
533
534

535
536

537
538
539

540
541
542
543
544
545
546
533
534
535
536
537
538
539

540
541

542
543
544
545
546
547
548
549
550
551
552
553







-
+

-
+



+







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

static int
ConsoleCloseProc(
    ClientData instanceData,	/* Pointer to ConsoleInfo structure. */
    Tcl_Interp *interp)		/* For error reporting. */
    Tcl_Interp *dummy)		/* For error reporting. */
{
    ConsoleInfo *consolePtr = instanceData;
    ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData;
    int errorCode = 0;
    ConsoleInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    /*
     * Clean up the background thread if necessary. Note that this must be
     * done before we can close the file, since the thread may be blocking
     * trying to read from the console.
     */

647
648
649
650
651
652
653
654

655
656
657
658
659
660
661
654
655
656
657
658
659
660

661
662
663
664
665
666
667
668







-
+







ConsoleInputProc(
    ClientData instanceData,	/* Console state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    DWORD count, bytesRead = 0;
    int result;

    *errorCode = 0;

    /*
     * Synchronize with the reader thread.
739
740
741
742
743
744
745
746

747
748
749
750
751
752
753
746
747
748
749
750
751
752

753
754
755
756
757
758
759
760







-
+







static int
ConsoleOutputProc(
    ClientData instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleThreadInfo *threadInfo = &infoPtr->writer;
    DWORD bytesWritten, timeout;

    *errorCode = 0;

    /* avoid blocking if pipe-thread exited */
    timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI)
783
784
785
786
787
788
789
790

791
792
793
794
795
796
797
790
791
792
793
794
795
796

797
798
799
800
801
802
803
804







-
+







	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	bytesWritten = toWrite;
    } else {
924
925
926
927
928
929
930
931

932
933
934
935
936
937
938
931
932
933
934
935
936
937

938
939
940
941
942
943
944
945







-
+







ConsoleWatchProc(
    ClientData instanceData,	/* Console state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    ConsoleInfo **nextPtrPtr, *ptr;
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    int oldMask = infoPtr->watchMask;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Since most of the work is handled by the background threads, we just
     * need to update the watchMask and then force the notifier to poll once.
     */
982
983
984
985
986
987
988
989


990
991
992
993
994
995
996
989
990
991
992
993
994
995

996
997
998
999
1000
1001
1002
1003
1004







-
+
+








static int
ConsoleGetHandleProc(
    ClientData instanceData,	/* The console state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    (void)direction;

    *handlePtr = infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1016
1017
1018
1019
1020
1021
1022
1023

1024
1025
1026
1027
1028
1029
1030
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034
1035
1036
1037
1038







-
+







static int
WaitForRead(
    ConsoleInfo *infoPtr,	/* Console state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE *handle = infoPtr->handle;
    HANDLE *handle = (HANDLE *)infoPtr->handle;
    ConsoleThreadInfo *threadInfo = &infoPtr->reader;
    INPUT_RECORD input;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */
1132
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154







-
+








	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	    /* exit */
	    break;
	}
	if (!infoPtr) {
	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
	    handle = infoPtr->handle;
	    handle = (HANDLE *)infoPtr->handle;
	    threadInfo = &infoPtr->reader;
	}


	/*
	 * Look for data on the console, but first ignore any events that are
	 * not KEY_EVENTs.
1230
1231
1232
1233
1234
1235
1236
1237

1238
1239
1240
1241
1242
1243
1244
1238
1239
1240
1241
1242
1243
1244

1245
1246
1247
1248
1249
1250
1251
1252







-
+







	 */
	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	    /* exit */
	    break;
	}
	if (!infoPtr) {
	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
	    handle = infoPtr->handle;
	    handle = (HANDLE *)infoPtr->handle;
	    threadInfo = &infoPtr->writer;
	}

	buf = infoPtr->writeBuf;
	toWrite = infoPtr->toWrite;

	/*
1317
1318
1319
1320
1321
1322
1323
1324

1325
1326
1327
1328
1329
1330
1331
1325
1326
1327
1328
1329
1330
1331

1332
1333
1334
1335
1336
1337
1338
1339







-
+








    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = ckalloc(sizeof(ConsoleInfo));
    infoPtr = (ConsoleInfo *)ckalloc(sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1409
1410
1411
1412
1413
1414
1415

1416
1417
1418
1419
1420
1421
1422
1423







-
+







 */

static void
ConsoleThreadActionProc(
    ClientData instanceData,
    int action)
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;

    /*
     * We do not access firstConsolePtr in the thread structures. This is not
     * for all serials managed by the thread, but only those we are watching.
     * Removal of the filevent handlers before transfer thus takes care of
     * this structure.
     */
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
1477







-
+







static int
ConsoleSetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    int len = strlen(optionName);
    int vlen = strlen(value);

    /*
     * Option -inputmode normal|password|raw
     */

1553
1554
1555
1556
1557
1558
1559
1560

1561
1562
1563
1564
1565
1566
1567
1561
1562
1563
1564
1565
1566
1567

1568
1569
1570
1571
1572
1573
1574
1575







-
+







static int
ConsoleGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    ConsoleInfo *infoPtr = instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    unsigned int len;
    char buf[TCL_INTEGER_SPACE];

    if (optionName == NULL) {
	len = 0;
    } else {

Changes to win/tclWinFCmd.c.

141
142
143
144
145
146
147
148
149


150
151
152
153
154
155
156
141
142
143
144
145
146
147


148
149
150
151
152
153
154
155
156







-
-
+
+







 */

int
TclpObjRenameFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
    return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
	    (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
}

static int
DoRenameFile(
    const WCHAR *nativeSrc,	/* Pathname of file or dir to be renamed
				 * (native). */
    const WCHAR *nativeDst)	/* New pathname for file or directory
532
533
534
535
536
537
538
539
540


541
542
543
544
545
546
547
532
533
534
535
536
537
538


539
540
541
542
543
544
545
546
547







-
-
+
+







 */

int
TclpObjCopyFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
    return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
	    (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
}

static int
DoCopyFile(
    const WCHAR *nativeSrc,	/* Pathname of file to be copied (native). */
    const WCHAR *nativeDst)	/* Pathname of file to copy to (native). */
{
747
748
749
750
751
752
753
754

755
756
757
758
759
760
761
747
748
749
750
751
752
753

754
755
756
757
758
759
760
761







-
+







}

int
TclpDeleteFile(
    const void *nativePath)	/* Pathname of file to be removed (native). */
{
    DWORD attr;
    const WCHAR *path = nativePath;
    const WCHAR *path = (const WCHAR *)nativePath;

    /*
     * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
     * "". Avoid passing these values.
     */

    if (path == NULL || path[0] == '\0') {
852
853
854
855
856
857
858
859

860
861
862
863
864
865
866
852
853
854
855
856
857
858

859
860
861
862
863
864
865
866







-
+







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

int
TclpObjCreateDirectory(
    Tcl_Obj *pathPtr)
{
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
    return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    const WCHAR *nativePath)	/* Pathname of directory to create (native). */
{
    if (CreateDirectoryW(nativePath, NULL) == 0) {
989
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
989
990
991
992
993
994
995

996
997
998
999
1000
1001
1002
1003







-
+







	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(Tcl_GetString(normPtr), -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
1428
1429
1430
1431
1432
1433
1434


1435
1436
1437
1438
1439
1440
1441
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443







+
+







TraversalDelete(
    const WCHAR *nativeSrc,	/* Source pathname to delete. */
    const WCHAR *dstPtr,	/* Not used. */
    int type,			/* Reason for call - see TraverseWinTree() */
    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString filled
				 * with UTF-8 name of file causing error. */
{
    (void)dstPtr;

    switch (type) {
    case DOTREE_F:
	if (TclpDeleteFile(nativeSrc) == TCL_OK) {
	    return TCL_OK;
	}
	break;
    case DOTREE_LINK:
1513
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
1529







-
+







    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    DWORD result;
    const WCHAR *nativeName;
    int attr;

    nativeName = Tcl_FSGetNativePath(fileName);
    nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
    result = GetFileAttributesW(nativeName);

    if (result == 0xffffffff) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

1593
1594
1595
1596
1597
1598
1599

1600
1601
1602
1603
1604
1605
1606
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609







+







    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    int longShort,		/* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    int pathc, i;
    Tcl_Obj *splitPath;
    (void)objIndex;

    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": no such file or directory",
1839
1840
1841
1842
1843
1844
1845
1846

1847
1848
1849
1850
1851
1852
1853
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
1856







-
+







    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
{
    DWORD fileAttributes, old;
    int yesNo, result;
    const WCHAR *nativeName;

    nativeName = Tcl_FSGetNativePath(fileName);
    nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
    fileAttributes = old = GetFileAttributesW(nativeName);

    if (fileAttributes == 0xffffffff) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

1890
1891
1892
1893
1894
1895
1896


1897
1898
1899
1900
1901
1902
1903
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908







+
+







static int
CannotSetAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
{
    (void)attributePtr;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
	    tclpFileAttrStrings[objIndex], Tcl_GetString(fileName)));
    errno = EINVAL;
    Tcl_PosixError(interp);
    return TCL_ERROR;
}

Changes to win/tclWinFile.c.

934
935
936
937
938
939
940
941

942
943
944
945
946
947
948
934
935
936
937
938
939
940

941
942
943
944
945
946
947
948







-
+







	     */

	    int len;
	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    const char *str = TclGetStringFromObj(norm, &len);

	    native = Tcl_FSGetNativePath(pathPtr);
	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

975
976
977
978
979
980
981
982

983
984
985
986
987
988
989
975
976
977
978
979
980
981

982
983
984
985
986
987
988
989







-
+







	    return TCL_ERROR;
	}

	/*
	 * Verify that the specified path exists and is actually a directory.
	 */

	native = Tcl_FSGetNativePath(pathPtr);
	native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	if (native == NULL) {
	    return TCL_OK;
	}
	attr = GetFileAttributesW(native);

	if ((attr == INVALID_FILE_ATTRIBUTES)
	    || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
1497
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508
1509
1510
1511







-
+







	     * Get current domain
	     */

	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
	    if (rc != 0) {
		break;
	    }
	    domain = INT2PTR(-1); /* repeat once */
	    domain = (const char *)INT2PTR(-1); /* repeat once */
	}
	if (rc == 0) {
	    DWORD i, size = MAX_PATH;

	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) {
		size = lstrlenW(wHomeDir);
1916
1917
1918
1919
1920
1921
1922
1923

1924
1925
1926
1927
1928
1929
1930
1916
1917
1918
1919
1920
1921
1922

1923
1924
1925
1926
1927
1928
1929
1930







-
+







int
TclpObjChdir(
    Tcl_Obj *pathPtr)	/* Path to new working directory. */
{
    int result;
    const WCHAR *nativePath;

    nativePath = Tcl_FSGetNativePath(pathPtr);
    nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

    if (!nativePath) {
	return -1;
    }
    result = SetCurrentDirectoryW(nativePath);

    if (result == 0) {
2009
2010
2011
2012
2013
2014
2015
2016

2017
2018
2019
2020
2021
2022
2023
2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021
2022
2023







-
+







     * Ensure correct file sizes by forcing the OS to write any pending data
     * to disk. This is done only for channels which are dirty, i.e. have been
     * written to since the last flush here.
     */

    TclWinFlushDirtyChannels();

    return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 0);
    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeStat --
 *
2203
2204
2205
2206
2207
2208
2209
2210

2211
2212
2213
2214
2215
2216
2217
2203
2204
2205
2206
2207
2208
2209

2210
2211
2212
2213
2214
2215
2216
2217







-
+







	const WCHAR *nativeVol;
	Tcl_DString volString;

	p = strchr(fullPath + 2, '\\');
	p = strchr(p + 1, '\\');
	if (p == NULL) {
	    /*
	     * Add terminating backslash to fullpath or GetVolumeInformation()
	     * Add terminating backslash to fullpath or GetVolumeInformationW()
	     * won't work.
	     */

	    fullPath = TclDStringAppendLiteral(&ds, "\\");
	    p = fullPath + Tcl_DStringLength(&ds);
	} else {
	    p++;
2380
2381
2382
2383
2384
2385
2386
2387

2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403

2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423

2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435

2436
2437
2438
2439
2440
2441
2442
2380
2381
2382
2383
2384
2385
2386

2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402

2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415

2416
2417
2418
2419
2420
2421
2422

2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434

2435
2436
2437
2438
2439
2440
2441
2442







-
+















-
+












-
+






-
+











-
+







}

int
TclpObjAccess(
    Tcl_Obj *pathPtr,
    int mode)
{
    return NativeAccess(Tcl_FSGetNativePath(pathPtr), mode);
    return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode);
}

int
TclpObjLstat(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *statPtr)
{
    /*
     * Ensure correct file sizes by forcing the OS to write any pending data
     * to disk. This is done only for channels which are dirty, i.e. have been
     * written to since the last flush here.
     */

    TclWinFlushDirtyChannels();

    return NativeStat(Tcl_FSGetNativePath(pathPtr), statPtr, 1);
    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1);
}

#ifdef S_IFLNK
Tcl_Obj *
TclpObjLink(
    Tcl_Obj *pathPtr,
    Tcl_Obj *toPtr,
    int linkAction)
{
    if (toPtr != NULL) {
	int res;
	const WCHAR *LinkTarget;
	const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);

	if (normalizedToPtr == NULL) {
	    return NULL;
	}

	LinkTarget = Tcl_FSGetNativePath(normalizedToPtr);
	LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr);

	if (LinkSource == NULL || LinkTarget == NULL) {
	    return NULL;
	}
	res = WinLink(LinkSource, LinkTarget, linkAction);
	if (res == 0) {
	    return toPtr;
	} else {
	    return NULL;
	}
    } else {
	const WCHAR *LinkSource = Tcl_FSGetNativePath(pathPtr);
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

	if (LinkSource == NULL) {
	    return NULL;
	}
	return WinReadLink(LinkSource);
    }
}
2477
2478
2479
2480
2481
2482
2483
2484

2485
2486
2487
2488
2489
2490

2491
2492
2493
2494
2495
2496
2497
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489

2490
2491
2492
2493
2494
2495
2496
2497







-
+





-
+







    path = Tcl_GetString(normPath);
    if (path == NULL) {
	return NULL;
    }

    firstSeparator = strchr(path, '/');
    if (firstSeparator == NULL) {
	found = GetVolumeInformationW(Tcl_FSGetNativePath(pathPtr),
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),
		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
    } else {
	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);

	Tcl_IncrRefCount(driveName);
	found = GetVolumeInformationW(Tcl_FSGetNativePath(driveName),
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName),
		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
	Tcl_DecrRefCount(driveName);
    }

    if (found == 0) {
	return NULL;
    } else {
2537
2538
2539
2540
2541
2542
2543
2544

2545
2546
2547
2548
2549
2550
2551
2552
2553
2554

2555
2556
2557
2558
2559
2560
2561
2537
2538
2539
2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562







-
+










+







 *	modified in place.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    Tcl_Interp *interp,
    Tcl_Interp *dummy,
    Tcl_Obj *pathPtr,	        /* An unshared object containing the path to
				 * normalize */
    int nextCheckpoint)	        /* offset to start at in pathPtr */
{
    char *lastValidPathEnd = NULL;
    Tcl_DString dsNorm;		/* This will hold the normalized string. */
    char *path, *currentPathEndPosition;
    Tcl_Obj *temp = NULL;
    int isDrive = 1;
    Tcl_DString ds;		/* Some workspace. */
    (void)dummy;

    Tcl_DStringInit(&dsNorm);
    path = Tcl_GetString(pathPtr);

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
3110
3111
3112
3113
3114
3115
3116
3117

3118
3119
3120
3121
3122
3123
3124
3111
3112
3113
3114
3115
3116
3117

3118
3119
3120
3121
3122
3123
3124
3125







-
+







	}
    }

    /*
     * Overallocate 6 chars, making some room for extended paths
     */

    wp = nativePathPtr = ckalloc((len + 6) * sizeof(WCHAR));
    wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
    if (nativePathPtr==0) {
      goto done;
    }
    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr,
	    len + 1);

    /*
3208
3209
3210
3211
3212
3213
3214
3215

3216
3217
3218
3219
3220
3221
3222
3209
3210
3211
3212
3213
3214
3215

3216
3217
3218
3219
3220
3221
3222
3223







-
+








    if (clientData == NULL) {
	return NULL;
    }

    len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);

    copy = ckalloc(len);
    copy = (char *)ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
3245
3246
3247
3248
3249
3250
3251
3252

3253
3254
3255
3256
3257
3258
3259
3246
3247
3248
3249
3250
3251
3252

3253
3254
3255
3256
3257
3258
3259
3260







-
+







    DWORD attr = 0;
    DWORD flags = FILE_ATTRIBUTE_NORMAL;
    FILETIME lastAccessTime, lastModTime;

    FromCTime(tval->actime, &lastAccessTime);
    FromCTime(tval->modtime, &lastModTime);

    native = Tcl_FSGetNativePath(pathPtr);
    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

    attr = GetFileAttributesW(native);

    if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
	flags = FILE_FLAG_BACKUP_SEMANTICS;
    }

3296
3297
3298
3299
3300
3301
3302
3303

3304
3305
3306
3307
3308
3309
3310
3297
3298
3299
3300
3301
3302
3303

3304
3305
3306
3307
3308
3309
3310
3311







-
+







    PSID ownerSid = NULL;
    PSECURITY_DESCRIPTOR secd = NULL;
    HANDLE token;
    LPBYTE buf = NULL;
    DWORD bufsz;
    int owned = 0;

    native = Tcl_FSGetNativePath(pathPtr);
    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

    if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT,
	    OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL,
	    &secd) != ERROR_SUCCESS) {
        /*
	 * Either not a file, or we do not have access to it in which case we
	 * are in all likelihood not the owner.
3324
3325
3326
3327
3328
3329
3330
3331

3332
3333
3334
3335
3336
3337
3338
3325
3326
3327
3328
3329
3330
3331

3332
3333
3334
3335
3336
3337
3338
3339







-
+







        /*
	 * Find out how big the buffer needs to be.
	 */

        bufsz = 0;
        GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
        if (bufsz) {
            buf = ckalloc(bufsz);
            buf = (LPBYTE)ckalloc(bufsz);
            if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
                owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
            }
        }
        CloseHandle(token);
    }

Changes to win/tclWinInit.c.

222
223
224
225
226
227
228
229

230
231
232
233
234
235
236
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+








    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    *valuePtr = ckalloc(length);
    *valuePtr = (char *)ckalloc(length);
    memcpy(*valuePtr, bytes, length);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
359
360
361
362
363
364
365
366

367
368
369
370
371
372
373
359
360
361
362
363
364
365

366
367
368
369
370
371
372
373







-
+







	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
407
408
409
410
411
412
413

414
415
416
417
418
419
420
421







-
+







	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
639
640
641
642
643
644
645
646

647
648
649
650
651
652
653
639
640
641
642
643
644
645

646
647
648
649
650
651
652
653







-
+







    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.
     */

    length = strlen(name);
    nameUpper = ckalloc(length + 1);
    nameUpper = (char *)ckalloc(length + 1);
    memcpy(nameUpper, name, length+1);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	/*
	 * Chop the env string off after the equal sign, then Convert the name

Changes to win/tclWinLoad.c.

63
64
65
66
67
68
69

70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85







+







-
+







				 * file. */
    int flags)
{
    HINSTANCE hInstance = NULL;
    const WCHAR *nativeName;
    Tcl_LoadHandle handlePtr;
    DWORD firstError;
    (void)flags;

    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativeName = Tcl_FSGetNativePath(pathPtr);
    nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    if (nativeName != NULL) {
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
    }
    if (hInstance == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182







-
+







	return TCL_ERROR;
    }

    /*
     * Succeded; package everything up for Tcl.
     */

    handlePtr = ckalloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr = (Tcl_LoadHandle)ckalloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213

214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
200
201
202
203
204
205
206

207
208
209
210
211
212
213

214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229







-
+






-
+







-
+







static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
    Tcl_PackageInitProc *proc = NULL;
    void *proc = NULL;

    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    proc = (void *) GetProcAddress(hInstance, symbol);
    proc = (void *)GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	TclDStringAppendLiteral(&ds, "_");
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	proc = (void *)GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\"", symbol));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
    }
282
283
284
285
286
287
288



289
290
291
292
293
294
295
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299







+
+
+







int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    (void)fileName;
    (void)bufPtr;

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
428
429
430
431
417
418
419
420
421
422
423

424
425
426
427
428
429
430
431
432
433
434
435







-
+











    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:
    dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
    dllDirectoryName = (WCHAR *)ckalloc((nameLen+1) * sizeof(WCHAR));
    wcscpy(dllDirectoryName, name);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinPipe.c.

306
307
308
309
310
311
312
313

314
315
316
317
318
319

320
321
322
323
324
325
326
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320
321
322
323
324
325
326
327







-
+






+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
PipeSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    PipeInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Look to see if any events are already pending.  If they are, poll.
359
360
361
362
363
364
365
366

367
368
369
370
371
372

373
374
375
376
377
378
379
360
361
362
363
364
365
366

367
368
369
370
371
372
373
374
375
376
377
378
379
380
381







-
+






+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
PipeCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    PipeInfo *infoPtr;
    PipeEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready pipes that don't already have events queued.
398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
400
401
402
403
404
405
406

407
408
409
410
411
412
413
414







-
+







	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    evPtr = ckalloc(sizeof(PipeEvent));
	    evPtr = (PipeEvent *)ckalloc(sizeof(PipeEvent));
	    evPtr->header.proc = PipeEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
431
432
433
434
435
436
437

438
439
440
441
442
443
444
445







-
+








TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = ckalloc(sizeof(WinFile));
    filePtr = (WinFile *)ckalloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*
1759
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772
1773
1761
1762
1763
1764
1765
1766
1767

1768
1769
1770
1771
1772
1773
1774
1775







-
+







    TclFile writeFile,		/* If non-null, gives the file for writing. */
    TclFile errorFile,		/* If non-null, gives the file where errors
				 * can be read. */
    int numPids,		/* The number of pids in the pid array. */
    Tcl_Pid *pidPtr)		/* An array of process identifiers. */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    PipeInfo *infoPtr = ckalloc(sizeof(PipeInfo));
    PipeInfo *infoPtr = (PipeInfo *)ckalloc(sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;
1856
1857
1858
1859
1860
1861
1862

1863
1864
1865
1866
1867
1868
1869
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872







+







    Tcl_Interp *interp,		/* Errors returned in result.*/
    Tcl_Channel *rchan,		/* Where to return the read side. */
    Tcl_Channel *wchan,		/* Where to return the write side. */
    int flags)			/* Reserved for future use. */
{
    HANDLE readHandle, writeHandle;
    SECURITY_ATTRIBUTES sec;
    (void)flags;

    sec.nLength = sizeof(SECURITY_ATTRIBUTES);
    sec.lpSecurityDescriptor = NULL;
    sec.bInheritHandle = FALSE;

    if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
	TclWinConvertError(GetLastError());
1913
1914
1915
1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1916
1917
1918
1919
1920
1921
1922

1923
1924
1925
1926
1927
1928
1929
1930







-
+







     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
	return;
    }

    pipePtr = Tcl_GetChannelInstanceData(chan);
    pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj,
		Tcl_NewWideIntObj((unsigned)
			TclpGetPid(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
2299
2300
2301
2302
2303
2304
2305
2306

2307
2308
2309
2310
2311
2312
2313
2302
2303
2304
2305
2306
2307
2308

2309
2310
2311
2312
2313
2314
2315
2316







-
+







	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = toWrite;
    } else {
2707
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2710
2711
2712
2713
2714
2715
2716

2717
2718
2719
2720
2721
2722
2723
2724







-
+







 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    unsigned long id)		/* Global process identifier */
{
    ProcInfo *procPtr = ckalloc(sizeof(ProcInfo));
    ProcInfo *procPtr = (ProcInfo*)ckalloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;
2749
2750
2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766







+







    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    const Tcl_ChannelType *chanTypePtr;
    PipeInfo *pipePtr;
    int i;
    Tcl_Obj *resultPtr;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
2808
2809
2810
2811
2812
2813
2814
2815

2816
2817
2818
2819
2820
2821
2822
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822
2823
2824
2825
2826







-
+







static int
WaitForRead(
    PipeInfo *infoPtr,		/* Pipe state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
    HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */

	/* avoid blocking if pipe-thread exited */
3196
3197
3198
3199
3200
3201
3202


3203
3204
3205
3206
3207
3208
3209
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215







+
+







{
    WCHAR name[MAX_PATH];
    char *namePtr;
    HANDLE handle;
    DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
    int length, counter, counter2;
    Tcl_DString buf;
    (void)dirObj;
    (void)extensionObj;

    if (!resultingNameObj) {
	flags |= FILE_FLAG_DELETE_ON_CLOSE;
    }

    namePtr = (char *) name;
    length = GetTempPathW(MAX_PATH, name);
3282
3283
3284
3285
3286
3287
3288
3289

3290
3291

3292
3293
3294
3295
3296
3297
3298
3288
3289
3290
3291
3292
3293
3294

3295
3296

3297
3298
3299
3300
3301
3302
3303
3304







-
+

-
+







TclPipeThreadCreateTI(
    TclPipeThreadInfo **pipeTIPtr,
    ClientData clientData,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = malloc(sizeof(TclPipeThreadInfo));
    pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = ckalloc(sizeof(TclPipeThreadInfo));
    pipeTI = (TclPipeThreadInfo *)ckalloc(sizeof(TclPipeThreadInfo));
#endif /* !_PTI_USE_CKALLOC */
    pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
    pipeTI->state = PTI_STATE_IDLE;
    pipeTI->clientData = clientData;
    pipeTI->evWakeUp = wakeEvent;
    return (*pipeTIPtr = pipeTI);
}

Changes to win/tclWinSerial.c.

281
282
283
284
285
286
287
288

289
290
291

292
293
294
295
296
297
298
281
282
283
284
285
286
287

288
289
290
291
292
293
294
295
296
297
298
299







-
+



+







 *	Removes the serial event source.
 *
 *----------------------------------------------------------------------
 */

static void
SerialExitHandler(
    ClientData clientData)	/* Old window proc */
    ClientData dummy)	/* Old window proc */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    SerialInfo *infoPtr;
    (void)dummy;

    /*
     * Clear all eventually pending output. Otherwise Tcl's exit could totally
     * block, because it performs a blocking flush on all open channels. Note
     * that serial write operations may be blocked due to handshake.
     */

319
320
321
322
323
324
325
326

327


328
329
330
331
332
333
334
320
321
322
323
324
325
326

327
328
329
330
331
332
333
334
335
336
337







-
+

+
+







 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    ClientData clientData)	/* Old window proc */
    ClientData dummy)	/* Old window proc */
{
    (void)dummy;

    Tcl_MutexLock(&serialMutex);
    initialized = 0;
    Tcl_MutexUnlock(&serialMutex);
}

/*
 *----------------------------------------------------------------------
396
397
398
399
400
401
402




403
404
405

406
407
408
409
410
411

412
413
414
415
416
417
418
399
400
401
402
403
404
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419
420
421
422
423
424
425
426







+
+
+
+


-
+






+







 *
 * Side effects:
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

#ifdef __cplusplus
#define min(a, b)  (((a) < (b)) ? (a) : (b))
#endif

void
SerialSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    int block = 1;
    int msec = INT_MAX;		/* min. found block time */
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Look to see if any events handlers installed. If they are, do not
453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
461
462
463
464
465
466
467

468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484







-
+








+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SerialCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    SerialEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    COMSTAT cStat;
    unsigned int time;
    (void)dummy;

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready serials that don't already have events
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
536
537
538
539
540
541
542

543
544
545
546
547
548
549
550







-
+








	/*
	 * Queue an event if the serial is signaled for reading or writing.
	 */

	if (needEvent) {
	    infoPtr->flags |= SERIAL_PENDING;
	    evPtr = ckalloc(sizeof(SerialEvent));
	    evPtr = (SerialEvent *)ckalloc(sizeof(SerialEvent));
	    evPtr->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

593
594
595
596
597
598
599
600

601
602
603
604
605

606
607
608
609
610
611
612
602
603
604
605
606
607
608

609
610
611
612
613
614
615
616
617
618
619
620
621
622







-
+





+







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

static int
SerialCloseProc(
    ClientData instanceData,    /* Pointer to SerialInfo structure. */
    Tcl_Interp *interp)		/* For error reporting. */
    Tcl_Interp *dummy)		/* For error reporting. */
{
    SerialInfo *serialPtr = (SerialInfo *) instanceData;
    int errorCode, result = 0;
    SerialInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    errorCode = 0;

    if (serialPtr->validMask & TCL_READABLE) {
	PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
	CloseHandle(serialPtr->osRead.hEvent);
    }
1026
1027
1028
1029
1030
1031
1032
1033

1034
1035
1036
1037
1038
1039
1040
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1050







-
+







	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = ckalloc(toWrite);
	    infoPtr->writeBuf = (char *)ckalloc(toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	bytesWritten = (DWORD) toWrite;

1242
1243
1244
1245
1246
1247
1248

1249
1250
1251
1252
1253
1254
1255
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266







+







static int
SerialGetHandleProc(
    ClientData instanceData,	/* The serial state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    (void)direction;

    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1443
1444
1445
1446
1447
1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
1454
1455
1456
1457
1458
1459
1460

1461
1462
1463
1464
1465
1466
1467
1468







-
+







    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;

    SerialInit();

    infoPtr = ckalloc(sizeof(SerialInfo));
    infoPtr = (SerialInfo *)ckalloc(sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;

Changes to win/tclWinSock.c.

306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320







-
+







	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};

/*
 * Simple wrapper round the SendMessage syscall.
 */

#define SendSelectMessage(tsdPtr, message, payload)     \
    SendMessage((tsdPtr)->hwnd, SOCKET_SELECT,          \
    SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT,          \
                (WPARAM) (message), (LPARAM) (payload))


/*
 * Address print debug functions
 */
#if 0
393
394
395
396
397
398
399
400

401
402
403
404
405
406
407
393
394
395
396
397
398
399

400
401
402
403
404
405
406
407







-
+







	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *valuePtr = (char *)ckalloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+











-
+







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

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Careful! This is a finalizer!
     */

    if (tsdPtr == NULL) {
	return;
    }

    if (tsdPtr->socketThread != NULL) {
	if (tsdPtr->hwnd != NULL) {
	    PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);
	    PostMessageW(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);

	    /*
	     * Wait for the thread to exit. This ensures that we are
	     * completely cleaned up before we leave this function.
	     */

	    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
546
547
548
549
550
551
552
553

554
555
556
557
558
559
560
546
547
548
549
550
551
552

553
554
555
556
557
558
559
560







-
+







static int
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
        CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    return 0;
642
643
644
645
646
647
648
649
650


651
652

653
654
655
656
657
658
659
642
643
644
645
646
647
648


649
650
651

652
653
654
655
656
657
658
659







-
-
+
+

-
+








    /*
     * Loop in the blocking case until the connect signal is present
     */

    while (1) {
	/*
         * Get the statePtr lock.
         */
	 * Get the statePtr lock.
	 */

        tsdPtr = TclThreadDataKeyGet(&dataKey);
	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
         * Check for connect event.
         */

	if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
779
780
781
782
783
784
785
786

787
788
789

790
791
792
793
794
795
796
779
780
781
782
783
784
785

786
787
788

789
790
791
792
793
794
795
796







-
+


-
+







TcpInputProc(
    ClientData instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
922
923
924
925
926
927
928
929

930
931
932

933
934
935
936
937
938
939
922
923
924
925
926
927
928

929
930
931

932
933
934
935
936
937
938
939







-
+


-
+







static int
TcpOutputProc(
    ClientData instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
1034
1035
1036
1037
1038
1039
1040
1041

1042
1043

1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1034
1035
1036
1037
1038
1039
1040

1041
1042

1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054







-
+

-
+



+







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

    /* ARGSUSED */
static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp)		/* Unused. */
    Tcl_Interp *dummy)		/* Unused. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

1131
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1132
1133
1134
1135
1136
1137
1138

1139
1140
1141
1142
1143
1144
1145
1146







-
+








static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;

    /*
     * Shutdown the OS socket handle.
     */

1185
1186
1187
1188
1189
1190
1191


1192

1193
1194
1195
1196
1197
1198
1199
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203







+
+

+







    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    const char *value)		/* New value for option. */
{
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SOCKET sock;
#else
    (void)instanceData;
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
    (void)value;

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

1288
1289
1290
1291
1292
1293
1294
1295

1296
1297
1298
1299
1300
1301
1302
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1306







-
+







    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SOCKET sock;
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"

    /*
1607
1608
1609
1610
1611
1612
1613
1614

1615
1616
1617
1618
1619
1620
1621
1611
1612
1613
1614
1615
1616
1617

1618
1619
1620
1621
1622
1623
1624
1625







-
+







static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. [Bug 557878]
     */

    if (!statePtr->acceptProc) {
1661
1662
1663
1664
1665
1666
1667
1668


1669
1670
1671
1672
1673
1674
1675
1665
1666
1667
1668
1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
1679
1680







-
+
+







	/* ARGSUSED */
static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    int direction,		/* Not used. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    (void)direction;

    *handlePtr = INT2PTR(statePtr->sockets->fd);
    return TCL_OK;
}



1718
1719
1720
1721
1722
1723
1724
1725

1726
1727
1728
1729
1730
1731
1732
1723
1724
1725
1726
1727
1728
1729

1730
1731
1732
1733
1734
1735
1736
1737







-
+







    int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
                                /* We are started with async connect and the
                                 * connect notification was not yet
                                 * received. */
    int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                                /* We were called by the event procedure and
                                 * continue our loop. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
	    statePtr->addr = statePtr->addr->ai_next) {
2137
2138
2139
2140
2141
2142
2143
2144

2145
2146
2147
2148
2149
2150
2151
2142
2143
2144
2145
2146
2147
2148

2149
2150
2151
2152
2153
2154
2155
2156







-
+







    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    tsdPtr = TclThreadDataKeyGet(&dataKey);
    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

2329
2330
2331
2332
2333
2334
2335
2336

2337
2338
2339
2340
2341
2342
2343
2334
2335
2336
2337
2338
2339
2340

2341
2342
2343
2344
2345
2346
2347
2348







-
+








  error:
    if (addrlist != NULL) {
	freeaddrinfo(addrlist);
    }

    if (statePtr != NULL) {
	ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

	statePtr->acceptProc = acceptProc;
	statePtr->acceptProcData = acceptProcData;
	sprintf(channelName, SOCK_TEMPLATE, statePtr);
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	/*
2397
2398
2399
2400
2401
2402
2403
2404

2405
2406
2407
2408
2409
2410
2411
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
2416







-
+







    address addr)       /* Address of new socket. */
{
    TcpState *newInfoPtr;
    TcpState *statePtr = fds->statePtr;
    int len = sizeof(addr);
    char channelName[SOCK_CHAN_LENGTH];
    char host[NI_MAXHOST], port[NI_MAXSERV];
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Win-NT has a misfeature that sockets are inherited in child processes
     * by default. Turn off the inherit bit.
     */

    SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);
2468
2469
2470
2471
2472
2473
2474
2475

2476
2477
2478
2479
2480
2481
2482
2473
2474
2475
2476
2477
2478
2479

2480
2481
2482
2483
2484
2485
2486
2487







-
+







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

static void
InitSockets(void)
{
    DWORD id;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*
	 * Create the async notification window with a new class. We must
2517
2518
2519
2520
2521
2522
2523
2524

2525
2526
2527
2528

2529
2530
2531
2532
2533
2534
2535
2522
2523
2524
2525
2526
2527
2528

2529
2530
2531
2532

2533
2534
2535
2536
2537
2538
2539
2540







-
+



-
+







     */

    tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->pendingTcpState = NULL;
    tsdPtr->socketList = NULL;
    tsdPtr->hwnd       = NULL;
    tsdPtr->threadId   = Tcl_GetCurrentThread();
    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
    tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
    if (tsdPtr->readyEvent == NULL) {
	goto initFailure;
    }
    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
    tsdPtr->socketListLock = CreateEventW(NULL, FALSE, TRUE, NULL);
    if (tsdPtr->socketListLock == NULL) {
	goto initFailure;
    }
    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
	    &id);
    if (tsdPtr->socketThread == NULL) {
	goto initFailure;
2607
2608
2609
2610
2611
2612
2613
2614

2615


2616
2617
2618
2619
2620
2621
2622
2612
2613
2614
2615
2616
2617
2618

2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629







-
+

+
+







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

    /* ARGSUSED */
static void
SocketExitHandler(
    ClientData clientData)		/* Not used. */
    ClientData dummy)		/* Not used. */
{
    (void)dummy;

    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

2641
2642
2643
2644
2645
2646
2647
2648

2649
2650
2651
2652
2653

2654
2655
2656
2657
2658
2659
2660
2648
2649
2650
2651
2652
2653
2654

2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668







-
+





+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
SocketSetupProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready socket.	 If so, poll.
2686
2687
2688
2689
2690
2691
2692
2693

2694
2695
2696
2697
2698

2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717

2718
2719
2720
2721
2722
2723
2724
2694
2695
2696
2697
2698
2699
2700

2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725

2726
2727
2728
2729
2730
2731
2732
2733







-
+





+


















-
+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SocketCheckProc(
    ClientData data,		/* Not used. */
    ClientData dummy,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    SocketEvent *evPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    (void)dummy;

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready sockets that don't already have events
     * queued (caused by persistent states that won't generate WinSock
     * events).
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
		statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
                && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
	    SET_BITS(statePtr->flags, SOCKET_PENDING);
	    evPtr = ckalloc(sizeof(SocketEvent));
	    evPtr = (SocketEvent *)ckalloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = statePtr->sockets->fd;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}
2985
2986
2987
2988
2989
2990
2991
2992

2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003

3004
3005
3006
3007
3008
3009
3010
2994
2995
2996
2997
2998
2999
3000

3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011

3012
3013
3014
3015
3016
3017
3018
3019







-
+










-
+







    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = ckalloc(sizeof(TcpFdList));
	statePtr->sockets = (TcpFdList *)ckalloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = ckalloc(sizeof(TcpFdList));
	fds->next = (TcpFdList *)ckalloc(sizeof(TcpFdList));
	fds = fds->next;
    }

    /*
     * Populate new FD.
     */

3029
3030
3031
3032
3033
3034
3035
3036

3037
3038
3039
3040
3041
3042
3043
3038
3039
3040
3041
3042
3043
3044

3045
3046
3047
3048
3049
3050
3051
3052







-
+







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

static TcpState *
NewSocketInfo(SOCKET socket)
{
    TcpState *statePtr = ckalloc(sizeof(TcpState));
    TcpState *statePtr = (TcpState *)ckalloc(sizeof(TcpState));

    memset(statePtr, 0, sizeof(TcpState));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
3072
3073
3074
3075
3076
3077
3078
3079

3080
3081
3082
3083
3084
3085
3086
3081
3082
3083
3084
3085
3086
3087

3088
3089
3090
3091
3092
3093
3094
3095







-
+







    int events,			/* Events to look for. May be one of
				 * FD_READ or FD_WRITE.
				 */
    int *errorCodePtr)		/* Where to store errors? */
{
    int result = 1;
    int oldMode;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);

3158
3159
3160
3161
3162
3163
3164
3165

3166
3167
3168
3169
3170
3171
3172
3167
3168
3169
3170
3171
3172
3173

3174
3175
3176
3177
3178
3179
3180
3181







-
+







 */

static DWORD WINAPI
SocketThread(
    LPVOID arg)
{
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg;

    /*
     * Create a dummy window receiving socket events.
     */

    tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0,
	    NULL, NULL, windowClass.hInstance, arg);
3184
3185
3186
3187
3188
3189
3190
3191

3192
3193
3194
3195
3196
3197
3198
3193
3194
3195
3196
3197
3198
3199

3200
3201
3202
3203
3204
3205
3206
3207







-
+







    if (tsdPtr->hwnd == NULL) {
	return 1;
    }

    /*
     * Process all messages on the socket window until WM_QUIT. This threads
     * exits only when instructed to do so by the call to
     * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
     * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets().
     */

    while (GetMessageW(&msg, NULL, 0, 0) > 0) {
	DispatchMessageW(&msg);
    }

    /*
3250
3251
3252
3253
3254
3255
3256
3257

3258
3259
3260
3261
3262
3263
3264
3259
3260
3261
3262
3263
3264
3265

3266
3267
3268
3269
3270
3271
3272
3273







-
+







    case WM_CREATE:
	/*
	 * Store the initial tsdPtr, it's from a different thread, so it's not
	 * directly accessible, but needed.
	 */

#ifdef _WIN64
	SetWindowLongPtr(hwnd, GWLP_USERDATA,
	SetWindowLongPtrW(hwnd, GWLP_USERDATA,
		(LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#else
	SetWindowLongW(hwnd, GWL_USERDATA,
		(LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#endif
	break;

3473
3474
3475
3476
3477
3478
3479
3480

3481
3482
3483
3484
3485
3486
3487
3482
3483
3484
3485
3486
3487
3488

3489
3490
3491
3492
3493
3494
3495
3496







-
+








static void
TcpThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr;
    TcpState *statePtr = instanceData;
    TcpState *statePtr = (TcpState *)instanceData;
    int notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * Ensure that socket subsystem is initialized in this thread, or else
	 * sockets will not work.
	 */

Changes to win/tclWinTest.c.

101
102
103
104
105
106
107
108

109
110
111
112
113
114
115

116
117
118
119
120
121
122
101
102
103
104
105
106
107

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123







-
+







+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventloopCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static int *framePtr = NULL;/* Pointer to integer on stack frame of
				 * innermost invocation of the "wait"
				 * subcommand. */
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ...");
	return TCL_ERROR;
    }
    if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
	*framePtr = 1;
177
178
179
180
181
182
183
184

185
186
187
188
189
190
191
192

193
194
195
196
197
198
199
178
179
180
181
182
183
184

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201







-
+








+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestvolumetypeCmd(
    ClientData clientData,	/* Not used. */
    ClientData dummy,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#define VOL_BUF_SIZE 32
    int found;
    char volType[VOL_BUF_SIZE];
    const char *path;
    (void)dummy;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	/*
256
257
258
259
260
261
262

263
264
265
266
267
268
269
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272







+







				/* The Posix epoch, expressed as a Windows
				 * FILETIME */
    Tcl_Time tclTime;		/* Tcl clock */
    FILETIME sysTime;		/* System clock */
    Tcl_Obj *result;		/* Result of the command */
    LARGE_INTEGER t1, t2;
    LARGE_INTEGER p1, p2;
    (void)dummy;

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

    QueryPerformanceCounter(&p1);
292
293
294
295
296
297
298
299

300
301
302
303
304

305
306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323


324
325
326
327
328
329
330
295
296
297
298
299
300
301

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322

323
324
325
326
327
328
329
330
331
332
333
334
335
336







-
+





+














-
+




+
+







    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}

static int
TestwinsleepCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int ms;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "ms");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &ms) != TCL_OK) {
	return TCL_ERROR;
    }
    Sleep((DWORD) ms);
    return TCL_OK;
}

static int
TestSizeCmd(
    ClientData clientData,	/* Unused */
    ClientData dummy,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    (void)dummy;

    if (objc != 2) {
	goto syntax;
    }
    if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t)));
	return TCL_OK;
    }
387
388
389
390
391
392
393

394
395
396
397
398
399
400
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407







+







	EXCEPTION_INT_DIVIDE_BY_ZERO, EXCEPTION_INT_OVERFLOW,
	EXCEPTION_PRIV_INSTRUCTION, EXCEPTION_IN_PAGE_ERROR,
	EXCEPTION_ILLEGAL_INSTRUCTION, EXCEPTION_NONCONTINUABLE_EXCEPTION,
	EXCEPTION_STACK_OVERFLOW, EXCEPTION_INVALID_DISPOSITION,
	EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT
    };
    int cmd;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "command", 0,
	    &cmd) != TCL_OK) {
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
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







-
+











-
+







    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = ckalloc(secDescLen);
	secDesc = (BYTE *)ckalloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {
	    goto done;
	}
    }

    /*
     * Get the World SID.
     */

    userSid = ckalloc(GetSidLengthRequired((UCHAR) 1));
    userSid = (SID *)ckalloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */

528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
535
536
537
538
539
540
541

542
543
544
545
546
547
548
549







-
+








    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = ckalloc(newAclSize);
    newAcl = (PACL) ckalloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
655
656
657
658
659
660
661

662
663
664
665
666
667
668
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676







+







TestchmodCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int i, mode;
    (void)dummy;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {

Changes to win/tclWinThrd.c.

564
565
566
567
568
569
570
571

572
573
574
575
576
577
578
564
565
566
567
568
569
570

571
572
573
574
575
576
577
578







-
+







	TclpMasterLock();

	/*
	 * Double inside master lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = ckalloc(sizeof(CRITICAL_SECTION));
	    csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpMasterUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
707
708
709
710
711
712
713
714

715
716
717
718
719
720
721
707
708
709
710
711
712
713

714
715
716
717
718
719
720
721







-
+







	TclpMasterLock();

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = ckalloc(sizeof(WinCondition));
	    winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpMasterUnlock();
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
936
937
938
939
940
941
942

943
944
945
946
947
948
949
950







-
+







#ifdef USE_THREAD_ALLOC

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    allocMutex *lockPtr;

    lockPtr = malloc(sizeof(allocMutex));
    lockPtr = (allocMutex *)malloc(sizeof(allocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
    InitializeCriticalSection(&lockPtr->wlock);
    return &lockPtr->tlock;
}
1033
1034
1035
1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058

1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096







-
+

















-
+













-
+










-
+















void *
TclpThreadCreateKey(void)
{
    DWORD *key;

    key = TclpSysAlloc(sizeof *key, 0);
    key = (DWORD *)TclpSysAlloc(sizeof *key, 0);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {
	Tcl_Panic("unable to allocate thread-local storage");
    }

    return key;
}

void
TclpThreadDeleteKey(
    void *keyPtr)
{
    DWORD *key = keyPtr;
    DWORD *key = (DWORD *)keyPtr;

    if (!TlsFree(*key)) {
	Tcl_Panic("unable to delete key");
    }

    TclpSysFree(keyPtr);
}

void
TclpThreadSetMasterTSD(
    void *tsdKeyPtr,
    void *ptr)
{
    DWORD *key = tsdKeyPtr;
    DWORD *key = (DWORD *)tsdKeyPtr;

    if (!TlsSetValue(*key, ptr)) {
	Tcl_Panic("unable to set master TSD value");
    }
}

void *
TclpThreadGetMasterTSD(
    void *tsdKeyPtr)
{
    DWORD *key = tsdKeyPtr;
    DWORD *key = (DWORD *)tsdKeyPtr;

    return TlsGetValue(*key);
}

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

Changes to win/tclWinTime.c.

94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
94
95
96
97
98
99
100

101
102
103
104
105
106
107
108







-
+







    { NULL, 0, 0, NULL, NULL, 0 },
    0,
    0,
    1,
    (HANDLE) NULL,
    (HANDLE) NULL,
    (HANDLE) NULL,
#ifdef HAVE_CAST_TO_UNION
#if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus)
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (ULARGE_INTEGER) (DWORDLONG) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
#else
    {0, 0},
410
411
412
413
414
415
416
417

418



419
420
421
422
423
424
425
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
425
426
427
428







-
+

+
+
+







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

static void
NativeScaleTime(
    Tcl_Time *timePtr,
    ClientData clientData)
    ClientData dummy)
{
    (void)timePtr;
    (void)dummy;

    /*
     * Native scale is 1:1. Nothing is done.
     */
}

/*
 *----------------------------------------------------------------------
645
646
647
648
649
650
651
652

653
654

655
656
657
658
659
660
661
648
649
650
651
652
653
654

655
656
657
658
659
660
661
662
663
664
665







-
+


+







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

static void
NativeGetTime(
    Tcl_Time *timePtr,
    ClientData clientData)
    ClientData dummy)
{
    Tcl_WideInt usecSincePosixEpoch;
    (void)dummy;

    /*
     * Try to use high resolution timer.
     */
    if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
	timePtr->sec = (long) (usecSincePosixEpoch / 1000000);
	timePtr->usec = (unsigned long) (usecSincePosixEpoch % 1000000);
690
691
692
693
694
695
696
697

698


699
700
701
702
703
704
705
694
695
696
697
698
699
700

701
702
703
704
705
706
707
708
709
710
711







-
+

+
+







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

void TclWinResetTimerResolution(void);

static void
StopCalibration(
    ClientData unused)		/* Client data is unused */
    ClientData dummy)		/* Client data is unused */
{
    (void)dummy;

    SetEvent(timeInfo.exitEvent);

    /*
     * If Tcl_Finalize was called from DllMain, the calibration thread is in a
     * paused state so we need to timeout and continue.
     */

973
974
975
976
977
978
979

980
981
982
983
984
985
986
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993







+








static DWORD WINAPI
CalibrationThread(
    LPVOID arg)
{
    FILETIME curFileTime;
    DWORD waitResult;
    (void)arg;

    /*
     * Get initial system time and performance counter.
     */

    GetSystemTimeAsFileTime(&curFileTime);
    QueryPerformanceCounter(&timeInfo.perfCounterLastCall);