Tcl Source Code

Check-in [c3634cbd75]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Changed finalization to move DLL unloading until the very last moment to avoid referencing memory for Mutex's and Thread Local Storage inside DLLs.

Fixed the thread send command to unlink the result from the global result list while still inside the mutex.

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: c3634cbd75f20e58573b3558d28692c335604c77
User & Date: welch 1999-04-03 01:35:19
Context
1999-04-03
01:46
Change log entry for Tcl_ConditionNotify and Tcl_ConditionWait check-in: 523bfb774e user: welch tags: core-8-1-branch-old
01:35
Changed finalization to move DLL unloading until the very last moment to avoid referencing memory fo... check-in: c3634cbd75 user: welch tags: core-8-1-branch-old
01:19
*** empty log message *** check-in: 11b0722d47 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclEvent.c. 

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
797
798
799
800
801
802
803
804

805
806
807
808
809
810
811
...
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
...
896
897
898
899
900
901
902








903
904
905
906
907
908
909

 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.1.2.9 1999/03/30 22:29:02 stanton Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The data structure below is used to report background errors.  One
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Finalize --
 *
 *	Runs the exit handlers to allow Tcl to clean up its state.

 *	Called by Tcl_Exit or when the Tcl shared library is being 
 *	unloaded.
 *
 * Results:
 *	None.
 *
 * Side effects:
................................................................................
	 * In particular, the testexithandler command sets up something
	 * that writes to standard output, which gets closed.
	 * Note that there is no thread-local storage after this call.
	 */
    
	Tcl_FinalizeThread();

	/*
	 * We defer unloading of packages until after any user callbacks
	 * are invoked to avoid memory access issues.
	 */

	TclFinalizeLoad();

	/*
	 * Now finalize the Tcl execution environment.  Note that this
	 * must be done after the exit handlers, because there are
	 * order dependencies.
	 */

	TclFinalizeCompExecEnv();
................................................................................
	/*
	 * Free synchronization objects.  There really should only be one
	 * thread alive at this moment.
	 */

	TclFinalizeSynchronization();









	/*
	 * There shouldn't be any malloc'ed memory after this.
	 */

	TclFinalizeMemorySubsystem();
	inFinalize = 0;
    }







|







 







|
>







 







<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>








7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
...
853
854
855
856
857
858
859







860
861
862
863
864
865
866
...
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911

 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclEvent.c,v 1.1.2.10 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The data structure below is used to report background errors.  One
................................................................................
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Finalize --
 *
 *	Shut down Tcl.  First calls registered exit handlers, then
 *	carefully shuts down various subsystems.
 *	Called by Tcl_Exit or when the Tcl shared library is being 
 *	unloaded.
 *
 * Results:
 *	None.
 *
 * Side effects:
................................................................................
	 * In particular, the testexithandler command sets up something
	 * that writes to standard output, which gets closed.
	 * Note that there is no thread-local storage after this call.
	 */
    
	Tcl_FinalizeThread();








	/*
	 * Now finalize the Tcl execution environment.  Note that this
	 * must be done after the exit handlers, because there are
	 * order dependencies.
	 */

	TclFinalizeCompExecEnv();
................................................................................
	/*
	 * Free synchronization objects.  There really should only be one
	 * thread alive at this moment.
	 */

	TclFinalizeSynchronization();

	/*
	 * We defer unloading of packages until very late 
	 * to avoid memory access issues.  Both exit callbacks and
	 * synchronization variables may be stored in packages.
	 */

	TclFinalizeLoad();

	/*
	 * There shouldn't be any malloc'ed memory after this.
	 */

	TclFinalizeMemorySubsystem();
	inFinalize = 0;
    }

Changes to generic/tclLoad.c. 

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
629
630
631
632
633
634
635
636









637
638
639
640
641
642
643
644
645
646
647
648

 *	on all platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclLoad.c,v 1.1.2.4 1999/03/30 22:29:03 stanton Exp $
 */

#include "tclInt.h"

/*
 * The following structure describes a package that has been loaded
 * either dynamically (with the "load" command) or statically (as
................................................................................
 */

void
TclFinalizeLoad()
{
    LoadedPackage *pkgPtr;

    Tcl_MutexLock(&packageMutex);









    while (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;
	if (pkgPtr->fileName[0] != '\0') {
	    TclpUnloadFile(pkgPtr->clientData);
	}
	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree((char *) pkgPtr);
    }
    Tcl_MutexUnlock(&packageMutex);
}







|







 







<
>
>
>
>
>
>
>
>
>










<


5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
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
654

655

 *	on all platforms) of Tcl's dynamic loading facilities.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclLoad.c,v 1.1.2.5 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"

/*
 * The following structure describes a package that has been loaded
 * either dynamically (with the "load" command) or statically (as
................................................................................
 */

void
TclFinalizeLoad()
{
    LoadedPackage *pkgPtr;


    /*
     * No synchronization here because there should just be
     * one thread alive at this point.  Logically, 
     * packageMutex should be grabbed at this point, but
     * the Mutexes get finalized before the call to this routine.
     * The only subsystem left alive at this point is the
     * memory allocator.
     */

    while (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;
	if (pkgPtr->fileName[0] != '\0') {
	    TclpUnloadFile(pkgPtr->clientData);
	}
	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree((char *) pkgPtr);
    }

}

Changes to generic/tclThreadTest.c. 

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
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
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765

 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclThreadTest.c,v 1.1.2.7 1999/04/03 01:19:48 stanton Exp $
 */

#include "tclInt.h"

#ifdef TCL_THREADS
/*
 * Each thread has an single instance of the following structure.  There
................................................................................

    /* 
     * Block on the results and then get them.
     */

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);
    if (resultPtr->result == NULL) {
        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
    }

















    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
................................................................................
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;

    if (resultPtr->prevPtr) {
	resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
    } else {
	resultList = resultPtr->nextPtr;
    }
    if (resultPtr->nextPtr) {
	resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
    }
    resultPtr->eventPtr = NULL;
    resultPtr->nextPtr = NULL;
    resultPtr->prevPtr = NULL;

    ckfree((char *) resultPtr);

    return code;
}

 
/*







|







 







|


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

>







 







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








7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
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
750
751
752
753
754
755
756
757
...
758
759
760
761
762
763
764












765
766
767
768
769
770
771

 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclThreadTest.c,v 1.1.2.8 1999/04/03 01:35:19 welch Exp $
 */

#include "tclInt.h"

#ifdef TCL_THREADS
/*
 * Each thread has an single instance of the following structure.  There
................................................................................

    /* 
     * Block on the results and then get them.
     */

    Tcl_ResetResult(interp);
    Tcl_MutexLock(&threadMutex);
    while (resultPtr->result == NULL) {
        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
    }

    /*
     * Unlink result from the result list.
     */

    if (resultPtr->prevPtr) {
	resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
    } else {
	resultList = resultPtr->nextPtr;
    }
    if (resultPtr->nextPtr) {
	resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
    }
    resultPtr->eventPtr = NULL;
    resultPtr->nextPtr = NULL;
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
................................................................................
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
    TclFinalizeCondition(&resultPtr->done);
    code = resultPtr->code;













    ckfree((char *) resultPtr);

    return code;
}

 
/*

This page was generated in about 0.017s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14