Tcl Source Code

Check-in [4d5b476573]
Login

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

Overview
Comment:Experimental branch where the interp->result field and related are removed and all simplifications that makes possible are done. Seems this can at best be a Tcl 9 reform.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-remove-string-result
Files: files | file ages | folders
SHA1: 4d5b4765731b510a6954f88465c70f3329fa3c72
User & Date: dgp 2012-04-18 18:42:54
Context
2012-04-19
12:20
merge trunk check-in: 13b3347e1d user: dkf tags: dgp-remove-string-result
2012-04-18
18:42
Experimental branch where the interp->result field and related are removed and all simplifications t... check-in: 4d5b476573 user: dgp tags: dgp-remove-string-result
2012-04-17
13:49
Restore the tcl_platform(threaded) variable. check-in: 5d93f81982 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.h.

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 * Note: any change to the Tcl_Interp definition below must be mirrored in the
 * "real" definition in tclInt.h.
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp {
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
#ifdef USE_INTERP_RESULT
    char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
				/* If the last command returned a string
				 * result, this points to it. */







|







495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
 * Note: any change to the Tcl_Interp definition below must be mirrored in the
 * "real" definition in tclInt.h.
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */
#if 0
typedef struct Tcl_Interp {
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
#ifdef USE_INTERP_RESULT
    char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
				/* If the last command returned a string
				 * result, this points to it. */
525
526
527
528
529
530
531


532
533
534
535
536
537
538
				/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
#else
    int unused5 TCL_DEPRECATED_API("bad field access");
#endif
} Tcl_Interp;



typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;







>
>







525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
				/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
#else
    int unused5 TCL_DEPRECATED_API("bad field access");
#endif
} Tcl_Interp;
#endif
typedef struct Tcl_Interp Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
 *----------------------------------------------------------------------------
 * The following structure contains the state needed by Tcl_SaveResult. No-one
 * outside of Tcl should access any of these fields. This structure is
 * typically allocated on the stack.
 */

typedef struct Tcl_SavedResult {
    char *result;
    Tcl_FreeProc *freeProc;
    Tcl_Obj *objResultPtr;
    char *appendResult;
    int appendAvl;
    int appendUsed;
    char resultSpace[TCL_RESULT_SIZE+1];
} Tcl_SavedResult;

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).







|
|

|
|
|
|







868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
 *----------------------------------------------------------------------------
 * The following structure contains the state needed by Tcl_SaveResult. No-one
 * outside of Tcl should access any of these fields. This structure is
 * typically allocated on the stack.
 */

typedef struct Tcl_SavedResult {
    char *unused1;
    Tcl_FreeProc *unused2;
    Tcl_Obj *objResultPtr;
    char *unused3;
    int unused4;
    int unused5;
    char unused6[TCL_RESULT_SIZE+1];
} Tcl_SavedResult;

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).

Changes to generic/tclBasic.c.

499
500
501
502
503
504
505

506
507

508
509
510
511
512
513
514
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

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


    iPtr->result = iPtr->resultSpace;
    iPtr->freeProc = NULL;

    iPtr->errorLine = 0;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;







>


>







499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

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

#if 0
    iPtr->result = iPtr->resultSpace;
    iPtr->freeProc = NULL;
#endif
    iPtr->errorLine = 0;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;
556
557
558
559
560
561
562

563
564
565

566
567
568
569
570
571
572
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;

    iPtr->rootFramePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->lookupNsPtr = NULL;


    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;


    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
	iPtr->packagePrefer = PKG_PREFER_STABLE;







>



>







558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;

    iPtr->rootFramePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->lookupNsPtr = NULL;

#if 0
    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;
#endif

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
	iPtr->packagePrefer = PKG_PREFER_STABLE;
587
588
589
590
591
592
593

594

595
596
597
598
599
600
601
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);

    iPtr->resultSpace[0] = 0;

    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {







>

>







591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
#if 0
    iPtr->resultSpace[0] = 0;
#endif
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
1489
1490
1491
1492
1493
1494
1495

1496

1497
1498
1499
1500
1501
1502
1503

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);

    iPtr->result = NULL;

    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }







>

>







1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
#if 0
    iPtr->result = NULL;
#endif
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
1511
1512
1513
1514
1515
1516
1517

1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }

    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
	iPtr->appendResult = NULL;
    }

    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }







>




>







1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }
#if 0
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
	iPtr->appendResult = NULL;
    }
#endif
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
 *	"Wrapper" Tcl_CmdProc used to call an existing object-based
 *	Tcl_ObjCmdProc if no string-based function exists for a command. A
 *	pointer to this function is stored as the Tcl_CmdProc in a Command
 *	structure. It simply turns around and calls the object Tcl_ObjCmdProc
 *	in the Command structure.
 *
 * Results:
 *	A standard Tcl string result value.
 *
 * Side effects:
 *	Besides those side effects of the called Tcl_CmdProc,
 *	TclInvokeStringCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */







|







2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
 *	"Wrapper" Tcl_CmdProc used to call an existing object-based
 *	Tcl_ObjCmdProc if no string-based function exists for a command. A
 *	pointer to this function is stored as the Tcl_CmdProc in a Command
 *	structure. It simply turns around and calls the object Tcl_ObjCmdProc
 *	in the Command structure.
 *
 * Results:
 *	A standard Tcl result value.
 *
 * Side effects:
 *	Besides those side effects of the called Tcl_CmdProc,
 *	TclInvokeStringCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */
2421
2422
2423
2424
2425
2426
2427

2428
2429
2430
2431
2432
2433

2434
2435
2436
2437
2438
2439
2440
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, argc, objv);
    }


    /*
     * Move the interpreter's object result to the string result, then reset
     * the object result.
     */

    (void) Tcl_GetStringResult(interp);


    /*
     * Decrement the ref counts for the argument objects created above, then
     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0; i < argc; i++) {







>






>







2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, argc, objv);
    }

#if 0
    /*
     * Move the interpreter's object result to the string result, then reset
     * the object result.
     */

    (void) Tcl_GetStringResult(interp);
#endif

    /*
     * Decrement the ref counts for the argument objects created above, then
     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0; i < argc; i++) {
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
 *	it was not deleted and if the nesting level is not too high.
 *
 * Results:
 *	The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	The interpreters object and string results are cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * Reset both the interpreter's string and object results and clear out
     * any previous error information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */







|











|
|







3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
 *	it was not deleted and if the nesting level is not too high.
 *
 * Results:
 *	The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	The interpreter's result is cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * Reset the interpreter's result and clear out any previous error
     * information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */
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
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
    Interp *iPtr = (Interp *) interp;
    NRE_callback *callbackPtr;
    Tcl_NRPostProc *procPtr;


    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
     * This only needs to be done for the first item in the list: all other
     * are for NR function calls, and those are Tcl_Obj based.
     */

    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }


    while (TOP_CB(interp) != rootPtr) {
	callbackPtr = TOP_CB(interp);
	procPtr = callbackPtr->procPtr;
	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);







|



>













>







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
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
/*    Interp *iPtr = (Interp *) interp;*/
    NRE_callback *callbackPtr;
    Tcl_NRPostProc *procPtr;

#if 0
    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     *
     * This only needs to be done for the first item in the list: all other
     * are for NR function calls, and those are Tcl_Obj based.
     */

    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
#endif

    while (TOP_CB(interp) != rootPtr) {
	callbackPtr = TOP_CB(interp);
	procPtr = callbackPtr->procPtr;
	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
5824
5825
5826
5827
5828
5829
5830

5831
5832
5833
5834
5835
5836
5837
5838
5839
5840


5841
5842
5843
5844
5845
5846
5847

int
Tcl_Eval(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *script)		/* Pointer to TCL command to execute. */
{

    int code = Tcl_EvalEx(interp, script, -1, 0);

    /*
     * For backwards compatibility with old C code that predates the object
     * system in Tcl 8.0, we have to mirror the object result back into the
     * string result (some callers may expect it there).
     */

    (void) Tcl_GetStringResult(interp);
    return code;


}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObj, Tcl_GlobalEvalObj --
 *







>










>
>







5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864

int
Tcl_Eval(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *script)		/* Pointer to TCL command to execute. */
{
#if 0
    int code = Tcl_EvalEx(interp, script, -1, 0);

    /*
     * For backwards compatibility with old C code that predates the object
     * system in Tcl 8.0, we have to mirror the object result back into the
     * string result (some callers may expect it there).
     */

    (void) Tcl_GetStringResult(interp);
    return code;
#endif
    return Tcl_EvalEx(interp, script, -1, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObj, Tcl_GlobalEvalObj --
 *
6331
6332
6333
6334
6335
6336
6337

6338
6339
6340

6341
6342
6343
6344
6345
6346
6347

	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);

	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}

    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,		/* Context in which to evaluate the







>



>







6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366

	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
#if 0
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
#endif
    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,		/* Context in which to evaluate the
6360
6361
6362
6363
6364
6365
6366

6367
6368
6369

6370
6371
6372
6373
6374
6375
6376
	*ptr = 0.0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
				/* Discard the expression object. */

	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}

    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,		/* Context in which to evaluate the







>



>







6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
6390
6391
6392
6393
6394
6395
6396
6397
	*ptr = 0.0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
				/* Discard the expression object. */
#if 0
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
#endif
    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,		/* Context in which to evaluate the
6388
6389
6390
6391
6392
6393
6394

6395
6396
6397
6398
6399
6400
6401
6402

6403
6404
6405
6406
6407
6408
6409
    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);

	if (result != TCL_OK) {
	    /*
	     * Move the interpreter's object result to the string result, then
	     * reset the object result.
	     */

	    (void) Tcl_GetStringResult(interp);
	}

	return result;
    }
}

/*
 *--------------------------------------------------------------
 *







>








>







6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
#if 0
	if (result != TCL_OK) {
	    /*
	     * Move the interpreter's object result to the string result, then
	     * reset the object result.
	     */

	    (void) Tcl_GetStringResult(interp);
	}
#endif
	return result;
    }
}

/*
 *--------------------------------------------------------------
 *
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732

6733
6734
6735
6736
6737
6738
6739
	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);
	}
    }

    /*
     * Force the string rep of the interp result.
     */

    (void) Tcl_GetStringResult(interp);

    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --







|





>







6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);
	}
    }
#if 0
    /*
     * Force the string rep of the interp result.
     */

    (void) Tcl_GetStringResult(interp);
#endif
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendObjToErrorInfo --
6829
6830
6831
6832
6833
6834
6835

6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846

6847

6848

6849
6850
6851
6852
6853
6854
6855
    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
     */

    iPtr->flags |= ERR_LEGACY_COPY;
    if (iPtr->errorInfo == NULL) {

	if (iPtr->result[0] != 0) {
	    /*
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
	} else {

	    iPtr->errorInfo = iPtr->objResultPtr;

	}

	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}
    }

    /*







>











>

>

>







6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
     */

    iPtr->flags |= ERR_LEGACY_COPY;
    if (iPtr->errorInfo == NULL) {
#if 0
	if (iPtr->result[0] != 0) {
	    /*
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
	} else {
#endif
	    iPtr->errorInfo = iPtr->objResultPtr;
#if 0
	}
#endif
	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}
    }

    /*
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
 * Tcl_VarEval --
 *
 *	Given a variable number of string arguments, concatenate them all
 *	together and execute the result as a Tcl command.
 *
 * Results:
 *	A standard Tcl return result. An error message or other result may be
 *	left in interp->result.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */







|







6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
 * Tcl_VarEval --
 *
 *	Given a variable number of string arguments, concatenate them all
 *	together and execute the result as a Tcl command.
 *
 * Results:
 *	A standard Tcl return result. An error message or other result may be
 *	left in the interp.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */

Changes to generic/tclHistory.c.

70
71
72
73
74
75
76

77
78
79
80
81
82

83
84
85
86
87
88
89
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, length);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);


	/*
	 * Move the interpreter's object result to the string result, then
	 * reset the object result.
	 */

	(void) Tcl_GetStringResult(interp);


	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {







>






>







70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, length);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);

#if 0
	/*
	 * Move the interpreter's object result to the string result, then
	 * reset the object result.
	 */

	(void) Tcl_GetStringResult(interp);
#endif

	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {

Changes to generic/tclInt.h.

1807
1808
1809
1810
1811
1812
1813

1814
1815
1816
1817
1818
1819
1820
1821
1822
1823




1824
1825
1826
1827
1828
1829
1830
     * The two fields are kept consistent unless some C code sets
     * interp->result directly. Programs should not access result and
     * objResultPtr directly; instead, they should always get and set the
     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
     * Tcl_GetStringResult. See the SetResult man page for details.
     */


    char *result;		/* If the last command returned a string
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
				 * allocated. TCL_DYNAMIC means string result
				 * was allocated with ckalloc and should be
				 * freed with ckfree. Other values give
				 * address of procedure to invoke to free the
				 * string result. Tcl_Eval must free it before
				 * executing next command. */




    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number in the command where the error
				 * occurred (1 means first line). */
    const struct TclStubs *stubTable;
				/* Pointer to the exported Tcl stub table. On
				 * previous versions of Tcl this is a pointer
				 * to the objResultPtr or a pointer to a







>










>
>
>
>







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
     * The two fields are kept consistent unless some C code sets
     * interp->result directly. Programs should not access result and
     * objResultPtr directly; instead, they should always get and set the
     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
     * Tcl_GetStringResult. See the SetResult man page for details.
     */

#if 0
    char *result;		/* If the last command returned a string
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
				 * allocated. TCL_DYNAMIC means string result
				 * was allocated with ckalloc and should be
				 * freed with ckfree. Other values give
				 * address of procedure to invoke to free the
				 * string result. Tcl_Eval must free it before
				 * executing next command. */
#else
    char *unused3;
    Tcl_FreeProc *unused4;
#endif
    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number in the command where the error
				 * occurred (1 means first line). */
    const struct TclStubs *stubTable;
				/* Pointer to the exported Tcl stub table. On
				 * previous versions of Tcl this is a pointer
				 * to the objResultPtr or a pointer to a
1874
1875
1876
1877
1878
1879
1880

1881
1882
1883
1884
1885
1886
1887





1888
1889
1890
1891
1892
1893
1894
				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */

    /*
     * Information used by Tcl_AppendResult to keep track of partial results.
     * See Tcl_AppendResult code for details.
     */


    char *appendResult;		/* Storage space for results generated by
				 * Tcl_AppendResult. Ckalloc-ed. NULL means
				 * not yet allocated. */
    int appendAvl;		/* Total amount of space available at
				 * partialResult. */
    int appendUsed;		/* Number of non-null bytes currently stored
				 * at partialResult. */






    /*
     * Information about packages. Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
				 * available to this interpreter. Keys are







>







>
>
>
>
>







1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */

    /*
     * Information used by Tcl_AppendResult to keep track of partial results.
     * See Tcl_AppendResult code for details.
     */

#if 0
    char *appendResult;		/* Storage space for results generated by
				 * Tcl_AppendResult. Ckalloc-ed. NULL means
				 * not yet allocated. */
    int appendAvl;		/* Total amount of space available at
				 * partialResult. */
    int appendUsed;		/* Number of non-null bytes currently stored
				 * at partialResult. */
#else
    char *unused5;
    int unused6;
    int unused7;
#endif

    /*
     * Information about packages. Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
				 * available to this interpreter. Keys are
1942
1943
1944
1945
1946
1947
1948

1949
1950



1951
1952
1953
1954
1955
1956
1957
    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
				 * execution. Contains a pointer to the Tcl
				 * evaluation stack. */
    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
				 * string. Returned by Tcl_ObjSetVar2 when
				 * variable traces change a variable in a
				 * gross way. */

    char resultSpace[TCL_RESULT_SIZE+1];
				/* Static space holding small results. */



    Tcl_Obj *objResultPtr;	/* If the last command returned an object
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */

    ActiveCommandTrace *activeCmdTracePtr;
				/* First in list of active command traces for







>


>
>
>







1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
				 * execution. Contains a pointer to the Tcl
				 * evaluation stack. */
    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
				 * string. Returned by Tcl_ObjSetVar2 when
				 * variable traces change a variable in a
				 * gross way. */
#if 0
    char resultSpace[TCL_RESULT_SIZE+1];
				/* Static space holding small results. */
#else
    char unused8[TCL_RESULT_SIZE+1];
#endif
    Tcl_Obj *objResultPtr;	/* If the last command returned an object
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */

    ActiveCommandTrace *activeCmdTracePtr;
				/* First in list of active command traces for

Changes to generic/tclResult.c.

23
24
25
26
27
28
29

30

31
32
33
34
35
36
37
/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);

static void		SetupAppendBuffer(Interp *iPtr, int newSpace);


/*
 * This structure is used to take a snapshot of the interpreter state in
 * Tcl_SaveInterpState. You can snapshot the state, execute a command, and
 * then back up to the result or the error that was previously in progress.
 */








>

>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);
#if 0
static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
#endif

/*
 * This structure is used to take a snapshot of the interpreter state in
 * Tcl_SaveInterpState. You can snapshot the state, execute a command, and
 * then back up to the result or the error that was previously in progress.
 */

243
244
245
246
247
248
249

250
251
252
253
254
255
256
     * reference. Put an empty object into the interpreter.
     */

    statePtr->objResultPtr = iPtr->objResultPtr;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);


    /*
     * Save the string result.
     */

    statePtr->freeProc = iPtr->freeProc;
    if (iPtr->result == iPtr->resultSpace) {
	/*







>







245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
     * reference. Put an empty object into the interpreter.
     */

    statePtr->objResultPtr = iPtr->objResultPtr;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);

#if 0
    /*
     * Save the string result.
     */

    statePtr->freeProc = iPtr->freeProc;
    if (iPtr->result == iPtr->resultSpace) {
	/*
280
281
282
283
284
285
286

287
288
289
290
291
292
293
	statePtr->result = iPtr->result;
	statePtr->appendResult = NULL;
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
    iPtr->freeProc = 0;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RestoreResult --
 *







>







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
	statePtr->result = iPtr->result;
	statePtr->appendResult = NULL;
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
    iPtr->freeProc = 0;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RestoreResult --
 *
309
310
311
312
313
314
315

316
317
318
319
320
321
322
    Tcl_Interp *interp,		/* Interpreter being restored. */
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);


    /*
     * Restore the string result.
     */

    iPtr->freeProc = statePtr->freeProc;
    if (statePtr->result == statePtr->resultSpace) {
	/*







>







313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
    Tcl_Interp *interp,		/* Interpreter being restored. */
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);

#if 0
    /*
     * Restore the string result.
     */

    iPtr->freeProc = statePtr->freeProc;
    if (statePtr->result == statePtr->resultSpace) {
	/*
341
342
343
344
345
346
347

348
349
350
351
352
353
354
    } else {
	/*
	 * Move the dynamic or static string back into the interpreter.
	 */

	iPtr->result = statePtr->result;
    }


    /*
     * Restore the object result.
     */

    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = statePtr->objResultPtr;







>







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
    } else {
	/*
	 * Move the dynamic or static string back into the interpreter.
	 */

	iPtr->result = statePtr->result;
    }
#endif

    /*
     * Restore the object result.
     */

    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = statePtr->objResultPtr;
374
375
376
377
378
379
380

381
382
383
384
385
386
387
388
389

390
391
392
393
394
395
396

void
Tcl_DiscardResult(
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    TclDecrRefCount(statePtr->objResultPtr);


    if (statePtr->result == statePtr->appendResult) {
	ckfree(statePtr->appendResult);
    } else if (statePtr->freeProc) {
	if (statePtr->freeProc == TCL_DYNAMIC) {
	    ckfree(statePtr->result);
	} else {
	    statePtr->freeProc(statePtr->result);
	}
    }

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *







>









>







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

void
Tcl_DiscardResult(
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    TclDecrRefCount(statePtr->objResultPtr);

#if 0
    if (statePtr->result == statePtr->appendResult) {
	ckfree(statePtr->appendResult);
    } else if (statePtr->freeProc) {
	if (statePtr->freeProc == TCL_DYNAMIC) {
	    ckfree(statePtr->result);
	} else {
	    statePtr->freeProc(statePtr->result);
	}
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *
412
413
414
415
416
417
418

419
420
421
422
423
424
425
				 * return value. */
    register char *result,	/* Value to be returned. If NULL, the result
				 * is set to an empty string. */
    Tcl_FreeProc *freeProc)	/* Gives information about the string:
				 * TCL_STATIC, TCL_VOLATILE, or the address of
				 * a Tcl_FreeProc such as free. */
{

    Interp *iPtr = (Interp *) interp;
    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
    char *oldResult = iPtr->result;

    if (result == NULL) {
	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;







>







420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
				 * return value. */
    register char *result,	/* Value to be returned. If NULL, the result
				 * is set to an empty string. */
    Tcl_FreeProc *freeProc)	/* Gives information about the string:
				 * TCL_STATIC, TCL_VOLATILE, or the address of
				 * a Tcl_FreeProc such as free. */
{
#if 0
    Interp *iPtr = (Interp *) interp;
    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
    char *oldResult = iPtr->result;

    if (result == NULL) {
	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;
455
456
457
458
459
460
461











462
463
464
465
466
467
468
    }

    /*
     * Reset the object result since we just set the string result.
     */

    ResetObjResult(iPtr);











}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *







>
>
>
>
>
>
>
>
>
>
>







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
    }

    /*
     * Reset the object result since we just set the string result.
     */

    ResetObjResult(iPtr);
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
	return;
    }
    if (freeProc == TCL_DYNAMIC) {
	ckfree(result);
    } else {
	(*freeProc)(result);
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *
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
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetStringResult(
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    Interp *iPtr = (Interp *) interp;

    if (*(iPtr->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return iPtr->result;




}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *







>












>
>
>
>







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

const char *
Tcl_GetStringResult(
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
#if 0
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    Interp *iPtr = (Interp *) interp;

    if (*(iPtr->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return iPtr->result;
#else
    Interp *iPtr = (Interp *)interp;
    return Tcl_GetString(iPtr->objResultPtr);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
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
    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);


    /*
     * Reset the string result since we just set the result object.
     */

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;

}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *







>














>







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
    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);

#if 0
    /*
     * Reset the string result since we just set the result object.
     */

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
573
574
575
576
577
578
579

580
581
582
583
584
585
586
 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    register Interp *iPtr = (Interp *) interp;

    Tcl_Obj *objResultPtr;
    int length;

    /*
     * If the string result is non-empty, move the string result to the object
     * result, then reset the string result.
     */







>







600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    register Interp *iPtr = (Interp *) interp;
#if 0
    Tcl_Obj *objResultPtr;
    int length;

    /*
     * If the string result is non-empty, move the string result to the object
     * result, then reset the string result.
     */
599
600
601
602
603
604
605

606
607
608
609
610
611
612
		iPtr->freeProc(iPtr->result);
	    }
	    iPtr->freeProc = 0;
	}
	iPtr->result = iPtr->resultSpace;
	iPtr->resultSpace[0] = 0;
    }

    return iPtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResultVA --







>







627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
		iPtr->freeProc(iPtr->result);
	    }
	    iPtr->freeProc = 0;
	}
	iPtr->result = iPtr->resultSpace;
	iPtr->resultSpace[0] = 0;
    }
#endif
    return iPtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResultVA --
717
718
719
720
721
722
723

724
725
726
727
728
729
730
Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;

    char *dst;
    int size;
    int flags;

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.







>







746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
#if 0
    char *dst;
    int size;
    int flags;

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
760
761
762
763
764
765
766





767












768
769
770
771
772
773
774
	 * then this element will not lead a list, and need not have it's
	 * leading '#' quoted.
	 */

	flags |= TCL_DONT_QUOTE_HASH;
    }
    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);





}













/*
 *----------------------------------------------------------------------
 *
 * SetupAppendBuffer --
 *
 *	This function makes sure that there is an append buffer properly







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







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
	 * then this element will not lead a list, and need not have it's
	 * leading '#' quoted.
	 */

	flags |= TCL_DONT_QUOTE_HASH;
    }
    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
#else
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    int length;
    const char *bytes;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    } 
    bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes+length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);
#endif
}
#if 0

/*
 *----------------------------------------------------------------------
 *
 * SetupAppendBuffer --
 *
 *	This function makes sure that there is an append buffer properly
841
842
843
844
845
846
847

848
849
850
851
852
853
854
    } else if (iPtr->result != iPtr->appendResult) {
	strcpy(iPtr->appendResult, iPtr->result);
    }

    Tcl_FreeResult((Tcl_Interp *) iPtr);
    iPtr->result = iPtr->appendResult;
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeResult --
 *
 *	This function frees up the memory associated with an interpreter's







>







888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
    } else if (iPtr->result != iPtr->appendResult) {
	strcpy(iPtr->appendResult, iPtr->result);
    }

    Tcl_FreeResult((Tcl_Interp *) iPtr);
    iPtr->result = iPtr->appendResult;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeResult --
 *
 *	This function frees up the memory associated with an interpreter's
870
871
872
873
874
875
876

877
878
879
880
881
882
883
884

885
886
887
888
889
890
891

void
Tcl_FreeResult(
    register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
    register Interp *iPtr = (Interp *) interp;


    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }


    ResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *







>








>







918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941

void
Tcl_FreeResult(
    register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
    register Interp *iPtr = (Interp *) interp;

#if 0
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
#endif

    ResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *
908
909
910
911
912
913
914

915
916
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
void
Tcl_ResetResult(
    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    register Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;

    if (iPtr->errorCode) {
	/* Legacy support */
	if (iPtr->flags & ERR_LEGACY_COPY) {
	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		    iPtr->errorCode, TCL_GLOBAL_ONLY);
	}
	Tcl_DecrRefCount(iPtr->errorCode);







>










>







958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
void
Tcl_ResetResult(
    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    register Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);
#if 0
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    iPtr->freeProc(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#endif
    if (iPtr->errorCode) {
	/* Legacy support */
	if (iPtr->flags & ERR_LEGACY_COPY) {
	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		    iPtr->errorCode, TCL_GLOBAL_ONLY);
	}
	Tcl_DecrRefCount(iPtr->errorCode);

Changes to generic/tclStubLib.c.

37
38
39
40
41
42
43
44
45
46
47






48
49
50
51
52
53
54
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
	return iPtr->stubTable;
    }

    iPtr->result =
	    (char *)"This interpreter does not support stubs-enabled extensions.";
    iPtr->freeProc = TCL_STATIC;






    return NULL;
}

/*
 * Use our own isdigit to avoid linking to libc on windows
 */








|



>
>
>
>
>
>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
	return iPtr->stubTable;
    }
#if 0
    iPtr->result =
	    (char *)"This interpreter does not support stubs-enabled extensions.";
    iPtr->freeProc = TCL_STATIC;
#else
    Tcl_Obj errorMsg = {2,
	    "This interpreter does not support stubs-enabled extensions.",
	    59, NULL, {0}};
    iPtr->objResultPtr = &errorMsg;
#endif
    return NULL;
}

/*
 * Use our own isdigit to avoid linking to libc on windows
 */

Changes to generic/tclTest.c.

116
117
118
119
120
121
122

123
124
125
126
127
128

129
130
131
132
133
134
135

typedef struct TclEncoding {
    Tcl_Interp *interp;
    char *toUtfCmd;
    char *fromUtfCmd;
} TclEncoding;


/*
 * The counter below is used to determine if the TestsaveresultFree routine
 * was called for a result.
 */

static int freeCount;


/*
 * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
 */

static int exitMainLoop = 0;








>






>







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

typedef struct TclEncoding {
    Tcl_Interp *interp;
    char *toUtfCmd;
    char *fromUtfCmd;
} TclEncoding;

#if 0
/*
 * The counter below is used to determine if the TestsaveresultFree routine
 * was called for a result.
 */

static int freeCount;
#endif

/*
 * Boolean flag used by the "testsetmainloop" and "testexitmainloop" commands.
 */

static int exitMainLoop = 0;

5059
5060
5061
5062
5063
5064
5065

5066

5067
5068
5069
5070
5071
5072
5073
static int
TestsaveresultCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{

    Interp* iPtr = (Interp*) interp;

    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {







>

>







5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075
5076
5077
static int
TestsaveresultCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
#if 0
    Interp* iPtr = (Interp*) interp;
#endif
    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
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
5145
5146
	break;
    case RESULT_OBJECT:
	objPtr = Tcl_NewStringObj("object result", -1);
	Tcl_SetObjResult(interp, objPtr);
	break;
    }


    freeCount = 0;

    Tcl_SaveResult(interp, &state);

    if (((enum options) index) == RESULT_OBJECT) {
	result = Tcl_EvalObjEx(interp, objv[2], 0);
    } else {
	result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
    }

    if (discard) {
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC: {

	int present = iPtr->freeProc == TestsaveresultFree;
	int called = freeCount;

	Tcl_AppendElement(interp, called ? "called" : "notCalled");
	Tcl_AppendElement(interp, present ? "present" : "missing");




	break;
    }
    case RESULT_OBJECT:
	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
		? "same" : "different");
	break;
    default:







>

>

















>





>
>
>
>







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
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
	break;
    case RESULT_OBJECT:
	objPtr = Tcl_NewStringObj("object result", -1);
	Tcl_SetObjResult(interp, objPtr);
	break;
    }

#if 0
    freeCount = 0;
#endif
    Tcl_SaveResult(interp, &state);

    if (((enum options) index) == RESULT_OBJECT) {
	result = Tcl_EvalObjEx(interp, objv[2], 0);
    } else {
	result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
    }

    if (discard) {
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC: {
#if 0
	int present = iPtr->freeProc == TestsaveresultFree;
	int called = freeCount;

	Tcl_AppendElement(interp, called ? "called" : "notCalled");
	Tcl_AppendElement(interp, present ? "present" : "missing");
#else
	Tcl_AppendElement(interp, discard ? "called" : "notCalled");
	Tcl_AppendElement(interp, !discard ? "present" : "missing");
#endif
	break;
    }
    case RESULT_OBJECT:
	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
		? "same" : "different");
	break;
    default:
5165
5166
5167
5168
5169
5170
5171

5172

5173
5174
5175
5176
5177
5178
5179
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    char *blockPtr)
{

    freeCount++;

}

/*
 *----------------------------------------------------------------------
 *
 * TestmainthreadCmd  --
 *







>

>







5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    char *blockPtr)
{
#if 0
    freeCount++;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TestmainthreadCmd  --
 *

Changes to generic/tclUtil.c.

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

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{

    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);

    if (dsPtr->string != dsPtr->staticSpace) {
	iPtr->result = dsPtr->string;
	iPtr->freeProc = TCL_DYNAMIC;
    } else if (dsPtr->length < TCL_RESULT_SIZE) {
	iPtr->result = iPtr->resultSpace;
	memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1);
    } else {

	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);

    }


    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}








>











>

>

>







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

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
#if 0
    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);

    if (dsPtr->string != dsPtr->staticSpace) {
	iPtr->result = dsPtr->string;
	iPtr->freeProc = TCL_DYNAMIC;
    } else if (dsPtr->length < TCL_RESULT_SIZE) {
	iPtr->result = iPtr->resultSpace;
	memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1);
    } else {
#endif
	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
#if 0
    }
#endif

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}

2668
2669
2670
2671
2672
2673
2674

2675
2676
2677
2678
2679
2680
2681

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{

    Interp *iPtr = (Interp *) interp;

    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }

    /*







>







2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686

void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
#if 0
    Interp *iPtr = (Interp *) interp;

    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }

    /*
2706
2707
2708
2709
2710
2711
2712








2713
2714
2715
2716
2717
2718
2719
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;








}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringStartSublist --
 *







>
>
>
>
>
>
>
>







2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
#else
    int length;
    char *bytes = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);

    Tcl_DStringFree(dsPtr);
    Tcl_DStringAppend(dsPtr, bytes, length);
    Tcl_ResetResult(interp);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringStartSublist --
 *