Tcl Source Code

Changes On Branch tip-530
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch tip-530 Excluding Merge-Ins

This is equivalent to a diff from 594a6ef663 to 68d2b424fb

2019-05-21
11:34
fixed mistake in optimization of [3f693cdfe9c875c4] (bypass of compareKeysProc if keys pointers/obje... check-in: 82f721a5a0 user: sebres tags: core-8-6-branch
2019-05-18
10:42
Surface TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS as configure --enable-line-continuations Leaf check-in: 68d2b424fb user: dkf tags: tip-530
09:08
Import of TIP 530 implementation, and update to follow Tcl Engineering Manual style. check-in: 60d629e262 user: dkf tags: tip-530
2019-05-17
10:40
merge 8.6 check-in: 645515e90f user: sebres tags: core-8-branch
2019-05-16
18:19
merge 8.5 check-in: 594a6ef663 user: sebres tags: core-8-6-branch
18:17
small amend to [ac566e9df84daeab] with rollback of done/continue optimization check-in: bb7ad323d4 user: sebres tags: core-8-5-branch
17:56
merge 8.5 (timerate fix to avoid impact of object duplication on shared interp result by the measure... check-in: dbe7cb43bc user: sebres tags: core-8-6-branch

Changes to generic/tclObj.c.

14
15
16
17
18
19
20









21
22
23
24
25
26
27
..
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
...
507
508
509
510
511
512
513


















































514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532






533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
...
569
570
571
572
573
574
575
576
577
578

579
580





581
582
583
584
585
586
587
...
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
...
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
705
706
707
...
724
725
726
727
728
729
730
731


732
733
734
735
736
737
738

739
740
741
742
743
744
745
...
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772


773
774
775
776
777
778
779
...
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
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include <math.h>










/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;
static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)
................................................................................
                                 * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

static void             TclThreadFinalizeContLines(ClientData clientData);
static ThreadSpecificData *TclGetContLineTable(void);

/*
 * Nested Tcl_Obj deletion management support
 *
 * All context references used in the object freeing code are pointers to this
 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
................................................................................
    tclFreeObjList = NULL;
    Tcl_MutexUnlock(&tclObjMutex);
}
 
/*
 *----------------------------------------------------------------------
 *


















































 * TclGetContLineTable --
 *
 *	This procedure is a helper which returns the thread-specific
 *	hash-table used to track continuation line information associated with
 *	Tcl_Obj*, and the objThreadMap, etc.
 *
 * Results:
 *	A reference to the thread-data.
 *
 * Side effects:
 *	May allocate memory for the thread-data.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
TclGetContLineTable(void)
{






    /*
     * Initialize the hashtable tracking invisible continuation lines.  For
     * the release we use a thread exit handler to ensure that this is done
     * before TSD blocks are made invalid. The TclFinalizeObjects() which
     * 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));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsEnter --
 *
................................................................................
ContLineLoc *
TclContinuationsEnter(
    Tcl_Obj *objPtr,
    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));






    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
	 * example test info-30.19 where the action (code) for all branches of
................................................................................
	 * doing.
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);

    return clLocPtr;
}
 
/*
................................................................................

    num = wordCLLast - clNext;
    if (num) {
	int i;
	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);

	/*
	 * Re-base the locations.

	 */


	for (i=0 ; i<num ; i++) {
	    clLocPtr->loc[i] -= start;

	    /*
	     * Continuation lines coming before the string and affecting us
	     * should not happen, due to the proper maintenance of clNext
	     * during compilation.
	     */

	    if (clLocPtr->loc[i] < 0) {
		Tcl_Panic("Derived ICL data for object using offsets from before the script");

	    }
	}
    }
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 */

void
TclContinuationsCopy(
    Tcl_Obj *objPtr,
    Tcl_Obj *originObjPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();


    Tcl_HashEntry *hPtr =
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);

    if (hPtr) {
	ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);

	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);

    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsGet --
................................................................................
 *----------------------------------------------------------------------
 */

ContLineLoc *
TclContinuationsGet(
    Tcl_Obj *objPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);

    if (!hPtr) {
        return NULL;
    }
    return Tcl_GetHashValue(hPtr);


}
 
/*
 *----------------------------------------------------------------------
 *
 * TclThreadFinalizeContLines --
 *
................................................................................
TclThreadFinalizeContLines(
    ClientData clientData)
{
    /*
     * Release the hashtable tracking invisible continuation lines.
     */

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;


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






>
>
>
>
>
>
>
>
>







 







|







 







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







|








|


>
>
>
>
>
>








|
<





|







 







<
|
<
>
|

>
>
>
>
>







 







|







 







|
>


>
|
|

|
|
|
|
|

|
|
>







 







|
>
>
|
<

|
|

|
>







 







|
|
|
|
|
|
|
|
>
>







 







|



>
|
|
|
|
|
|
|
|
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
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
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
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
...
633
634
635
636
637
638
639

640

641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
...
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
...
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
...
795
796
797
798
799
800
801
802
803
804
805

806
807
808
809
810
811
812
813
814
815
816
817
818
...
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
...
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
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tommath.h"
#include <math.h>

/*
 * Allow disabling (by default) of the performance cost of [info frame] as a
 * compile-time option.
 */

#ifndef TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS
#define TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS 1
#endif

/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;
static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)
................................................................................
                                 * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

static void             TclThreadFinalizeContLines(ClientData clientData);
static Tcl_HashTable *  TclGetContLineTable(void);

/*
 * Nested Tcl_Obj deletion management support
 *
 * All context references used in the object freeing code are pointers to this
 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
................................................................................
    tclFreeObjList = NULL;
    Tcl_MutexUnlock(&tclObjMutex);
}
 
/*
 *----------------------------------------------------------------------
 *
 * LineContinuationsMustBeTracked --
 *
 *      Bookkeeping of line continuation (backslash+newline) sequences with
 *      the purpose of reporting correct line numbers in the result of [info
 *      frame level] introduces noticeable overhead in TclFreeObj().
 *      Therefore that functionality can be turned on or off via the
 *      environment variable TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS
 *      (setting it to 0 results in improved performance at the cost of worse
 *      debuggability of Tcl scripts, while any other value has an opposite
 *      effect). During compilation, defining a macro with the same name sets
 *      the default value for that setting.
 *
 * Returns:
 *      A true value if we want detailed tracking, a false one if we don't.
 *
 * TIP #530
 *----------------------------------------------------------------------
 */

#define TRACK_CONTINUATIONS_NEEDS_INIT  (-1)

static int
LineContinuationsMustBeTracked(void)
{
    static int trackContinuations = TRACK_CONTINUATIONS_NEEDS_INIT;

    /*
     * Not technically thread safe, but two threads will assign the same
     * value.
     */

    if (trackContinuations == TRACK_CONTINUATIONS_NEEDS_INIT) {
        Tcl_DString buffer;
        const char *valuePtr = TclGetEnv(
                "TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS", &buffer);

        if (valuePtr == NULL) {
            trackContinuations =
                    (TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS != 0);
        } else {
            trackContinuations = (strcmp(valuePtr, "0") != 0);
            Tcl_DStringFree(&buffer);
        }
    }
    return trackContinuations;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclGetContLineTable --
 *
 *	This procedure is a helper which returns the thread-specific
 *	hash-table used to track continuation line information associated with
 *	Tcl_Obj*, and the objThreadMap, etc.
 *
 * Results:
 *	A reference to the hash table that is stored in thread-data.
 *
 * Side effects:
 *	May allocate memory for the thread-data.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static Tcl_HashTable *
TclGetContLineTable(void)
{
    ThreadSpecificData *tsdPtr;

    if (!LineContinuationsMustBeTracked()) {
        return NULL;
    }

    /*
     * Initialize the hashtable tracking invisible continuation lines.  For
     * the release we use a thread exit handler to ensure that this is done
     * before TSD blocks are made invalid. The TclFinalizeObjects() which
     * would be the natural place for this is invoked afterwards, meaning that
     * we try to operate on a data structure already gone.
     */

    tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr->lineCLPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsEnter --
 *
................................................................................
ContLineLoc *
TclContinuationsEnter(
    Tcl_Obj *objPtr,
    int num,
    int *loc)
{
    int newEntry;

    Tcl_HashEntry *hPtr;

    Tcl_HashTable *contLineTable = TclGetContLineTable();
    ContLineLoc *clLocPtr;

    if (!contLineTable) {
        return NULL;
    }
    hPtr = Tcl_CreateHashEntry(contLineTable, objPtr, &newEntry);
    clLocPtr = 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
	 * example test info-30.19 where the action (code) for all branches of
................................................................................
	 * doing.
	 */

	ckfree(Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num * sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);

    return clLocPtr;
}
 
/*
................................................................................

    num = wordCLLast - clNext;
    if (num) {
	int i;
	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);

	/*
	 * Re-base the locations. Note that TclContinuationsEnter() may return
	 * NULL if user policy has disabled continuation line tracking.
	 */

        if (clLocPtr != NULL) {
            for (i=0 ; i<num ; i++) {
                clLocPtr->loc[i] -= start;

                /*
                 * Continuation lines coming before the string and affecting
                 * us should not happen, due to the proper maintenance of
                 * clNext during compilation.
                 */

                if (clLocPtr->loc[i] < 0) {
                    Tcl_Panic("Derived ICL data for object using offsets from before the script");
                }
	    }
	}
    }
}
 
/*
 *----------------------------------------------------------------------
................................................................................
 */

void
TclContinuationsCopy(
    Tcl_Obj *objPtr,
    Tcl_Obj *originObjPtr)
{
    Tcl_HashTable *contLineTable = TclGetContLineTable();

    if (contLineTable) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(contLineTable, originObjPtr);


        if (hPtr) {
            ContLineLoc *clLocPtr = Tcl_GetHashValue(hPtr);

            TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
        }
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsGet --
................................................................................
 *----------------------------------------------------------------------
 */

ContLineLoc *
TclContinuationsGet(
    Tcl_Obj *objPtr)
{
    Tcl_HashTable *contLineTable = TclGetContLineTable();

    if (contLineTable) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(contLineTable, objPtr);

        if (hPtr) {
            return Tcl_GetHashValue(hPtr);
        }
    }
    return NULL;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclThreadFinalizeContLines --
 *
................................................................................
TclThreadFinalizeContLines(
    ClientData clientData)
{
    /*
     * Release the hashtable tracking invisible continuation lines.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    if (tsdPtr->lineCLPtr != NULL) {
        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 --
 *

Changes to unix/configure.

more than 10,000 changes

Changes to unix/configure.in.

647
648
649
650
651
652
653












654
655
656
657
658
659
660
    AC_HELP_STRING([--enable-dll-unloading],
	[enable the 'unload' command (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test $tcl_ok = yes; then
    AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?])
fi
AC_MSG_RESULT([$tcl_ok])













#------------------------------------------------------------------------
#	Check whether the timezone data is supplied by the OS or has
#	to be installed by Tcl. The default is autodetection, but can
#	be overriden on the configure command line either way.
#------------------------------------------------------------------------







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







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
    AC_HELP_STRING([--enable-dll-unloading],
	[enable the 'unload' command (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test $tcl_ok = yes; then
    AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?])
fi
AC_MSG_RESULT([$tcl_ok])

#------------------------------------------------------------------------

AC_MSG_CHECKING([whether to track line continuation])
AC_ARG_ENABLE(line-continuations,
    AC_HELP_STRING([--enable-line-continuations],
	[enable the tracking of line continuations for [info frame] (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test $tcl_ok = yes; then
    AC_DEFINE(TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS, 1, [Do we source code line numbers accurately?])
fi
AC_MSG_RESULT([$tcl_ok])

#------------------------------------------------------------------------
#	Check whether the timezone data is supplied by the OS or has
#	to be installed by Tcl. The default is autodetection, but can
#	be overriden on the configure command line either way.
#------------------------------------------------------------------------