Tcl package Thread source code

Check-in [c00a271dae]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:leave entries in persistent bound storage on exit handler (avoid flushing data by delete array, causes if tcl-application properly exits with call of all exit-handlers); additionally fixes memory leak on arrayPtr->bindAddr by unbind;
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | sebres-fix-persist-storage
Files: files | file ages | folders
SHA1: c00a271daea56194f0e902c46f580f98b729f8f0
User & Date: sebres 2017-07-19 18:26:25
References
2017-11-08
09:38 Ticket [770add1891] Flushing of persistent storage + mem-leak fix status still Open with 4 other changes artifact: e6b0c7dac5 user: sebres
2017-07-19
18:56 New ticket [770add1891]. artifact: f0ba80bdfc user: sebres
Context
2017-11-23
16:00
merge sebres-fix-persist-storage branches check-in: f2411eb665 user: sebres tags: trunk
2017-07-19
18:36
[win] allow lmdb (persistent storage) handler, if compiling for windows: ADDLINKOPTS and ADDOPTDEFINES can be specified to provide extra link- and compiler-options, for example: nmake -nologo -f makefile.vc TCLDIR=%TCLDIR% ... ADDOPTDEFINES="-I%LMDBDIR%" ADDLINKOPTS="%LMDBDIR%\Release\lmdb.lib" Closed-Leaf check-in: 31d323157d user: sebres tags: sebres-fix-persist-storage-win
18:26
leave entries in persistent bound storage on exit handler (avoid flushing data by delete array, causes if tcl-application properly exits with call of all exit-handlers); additionally fixes memory leak on arrayPtr->bindAddr by unbind; Closed-Leaf check-in: c00a271dae user: sebres tags: sebres-fix-persist-storage
2017-05-22
13:28
Update to latest TEA version check-in: 5de57fe262 user: jan.nijtmans tags: trunk, thread-2-8-1
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/threadSvCmd.c.

112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
832
833
834
835
836
837
838
839






















840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
....
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396




1397
1398
1399
1400
1401
1402
1403
....
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
....
2348
2349
2350
2351
2352
2353
2354



2355
2356
2357
2358
2359
2360
2361
2362
static Array* CreateArray(Bucket*, const char*);
static Array* LockArray(Tcl_Interp*, const char*, int);

static int ReleaseContainer(Tcl_Interp*, Container*, int);
static int DeleteContainer(Container*);
static int FlushArray(Array*);
static int DeleteArray(Array*);

static void SvAllocateContainers(Bucket*);
static void SvRegisterStdCommands(void);

#ifdef SV_FINALIZE
static void SvFinalizeContainers(Bucket*);
static void SvFinalize(ClientData);
................................................................................
 * Side effects:
 *      Memory gets reclaimed.
 *
 *-----------------------------------------------------------------------------
 */

static int
DeleteArray(Array *arrayPtr)






















{
    if (FlushArray(arrayPtr) == -1) {
        return TCL_ERROR;
    }
    if (arrayPtr->psPtr) {
        PsStore *psPtr = arrayPtr->psPtr;
        if (psPtr->psClose(psPtr->psHandle) == -1) {
            return TCL_ERROR;
        }
        ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
    }
    if (arrayPtr->bindAddr) {
        ckfree(arrayPtr->bindAddr);
    }
    if (arrayPtr->entryPtr) {
        Tcl_DeleteHashEntry(arrayPtr->entryPtr);
    }

    Tcl_DeleteHashTable(&arrayPtr->vars);
    ckfree((char*)arrayPtr);
................................................................................
                hPtr = Tcl_CreateHashEntry(&arrayPtr->vars, key, &new);
                Tcl_SetHashValue(hPtr, CreateContainer(arrayPtr, hPtr, tclObj));
                psPtr->psFree(psPtr->psHandle, val);
            } while (!psPtr->psNext(psPtr->psHandle, &key, &val, &len));
        }

    } else if (index == AUNBIND) {
        if (arrayPtr && arrayPtr->psPtr) {
            PsStore *psPtr = arrayPtr->psPtr;
            if (psPtr->psClose(psPtr->psHandle) == -1) {
                const char *err = psPtr->psError(psPtr->psHandle);
                Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1));
                ret = TCL_ERROR;
                goto cmdExit;
            }
            ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
        } else {
            Tcl_AppendResult(interp, "shared variable is not bound", NULL);
            ret = TCL_ERROR;
            goto cmdExit;




        }
    }

 cmdExit:
    if (arrayPtr) {
        UnlockArray(arrayPtr);
    }
................................................................................
    arrayPtr  = LockArray(interp, arrayName, 0);

    if (arrayPtr == NULL) {
        return TCL_ERROR;
    }
    if (objc == 2) {
        UnlockArray(arrayPtr);
        if (DeleteArray(arrayPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        for (ii = 2; ii < objc; ii++) {
            const char *key = Tcl_GetString(objv[ii]);
            Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&arrayPtr->vars, key);
            if (hPtr) {
................................................................................
        if (buckets != NULL) {
            for (i = 0; i < NUMBUCKETS; ++i) {
                Bucket *bucketPtr = &buckets[i];
                hashPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search);
                while (hashPtr != NULL) {
                    Array *arrayPtr = (Array*)Tcl_GetHashValue(hashPtr);
                    UnlockArray(arrayPtr);



                    DeleteArray(arrayPtr);
                    hashPtr = Tcl_NextHashEntry(&search);
                }
                if (bucketPtr->lock) {
                    Sp_RecursiveMutexFinalize(&bucketPtr->lock);
                }
                SvFinalizeContainers(bucketPtr);
                Tcl_DeleteHashTable(&bucketPtr->handles);






|







 







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





|
<

|
<
<
<
<







 







|
<
<
<
<
<
<
<
<
<



>
>
>
>







 







|







 







>
>
>
|







112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867

868
869




870
871
872
873
874
875
876
....
1394
1395
1396
1397
1398
1399
1400
1401









1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
....
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
....
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
static Array* CreateArray(Bucket*, const char*);
static Array* LockArray(Tcl_Interp*, const char*, int);

static int ReleaseContainer(Tcl_Interp*, Container*, int);
static int DeleteContainer(Container*);
static int FlushArray(Array*);
static int DeleteArray(Tcl_Interp *, Array*);

static void SvAllocateContainers(Bucket*);
static void SvRegisterStdCommands(void);

#ifdef SV_FINALIZE
static void SvFinalizeContainers(Bucket*);
static void SvFinalize(ClientData);
................................................................................
 * Side effects:
 *      Memory gets reclaimed.
 *
 *-----------------------------------------------------------------------------
 */

static int
UnbindArray(Tcl_Interp *interp, Array *arrayPtr)
{
    PsStore *psPtr = arrayPtr->psPtr;
    if (arrayPtr->bindAddr) {
        ckfree(arrayPtr->bindAddr);
        arrayPtr->bindAddr = NULL;
    }
    if (psPtr) {
        if (psPtr->psClose(psPtr->psHandle) == -1) {
            if (interp) {
                const char *err = psPtr->psError(psPtr->psHandle);
                Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1));
            }
            return TCL_ERROR;
        }
        ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
        arrayPtr->psPtr = NULL;
    }
    return TCL_OK;
}

static int
DeleteArray(Tcl_Interp *interp, Array *arrayPtr)
{
    if (FlushArray(arrayPtr) == -1) {
        return TCL_ERROR;
    }
    if (arrayPtr->psPtr) {
        if (UnbindArray(interp, arrayPtr) != TCL_OK) {

            return TCL_ERROR;
        };




    }
    if (arrayPtr->entryPtr) {
        Tcl_DeleteHashEntry(arrayPtr->entryPtr);
    }

    Tcl_DeleteHashTable(&arrayPtr->vars);
    ckfree((char*)arrayPtr);
................................................................................
                hPtr = Tcl_CreateHashEntry(&arrayPtr->vars, key, &new);
                Tcl_SetHashValue(hPtr, CreateContainer(arrayPtr, hPtr, tclObj));
                psPtr->psFree(psPtr->psHandle, val);
            } while (!psPtr->psNext(psPtr->psHandle, &key, &val, &len));
        }

    } else if (index == AUNBIND) {
        if (!arrayPtr || !arrayPtr->psPtr) {









            Tcl_AppendResult(interp, "shared variable is not bound", NULL);
            ret = TCL_ERROR;
            goto cmdExit;
        }
        if (UnbindArray(interp, arrayPtr) != TCL_OK) {
            ret = TCL_ERROR;
            goto cmdExit;
        }
    }

 cmdExit:
    if (arrayPtr) {
        UnlockArray(arrayPtr);
    }
................................................................................
    arrayPtr  = LockArray(interp, arrayName, 0);

    if (arrayPtr == NULL) {
        return TCL_ERROR;
    }
    if (objc == 2) {
        UnlockArray(arrayPtr);
        if (DeleteArray(interp, arrayPtr) != TCL_OK) {
            return TCL_ERROR;
        }
    } else {
        for (ii = 2; ii < objc; ii++) {
            const char *key = Tcl_GetString(objv[ii]);
            Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&arrayPtr->vars, key);
            if (hPtr) {
................................................................................
        if (buckets != NULL) {
            for (i = 0; i < NUMBUCKETS; ++i) {
                Bucket *bucketPtr = &buckets[i];
                hashPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search);
                while (hashPtr != NULL) {
                    Array *arrayPtr = (Array*)Tcl_GetHashValue(hashPtr);
                    UnlockArray(arrayPtr);
                    /* unbind array before delete (avoid flush of persistent storage) */
                    UnbindArray(NULL, arrayPtr);
                    /* flush, delete etc. */
                    DeleteArray(NULL, arrayPtr);
                    hashPtr = Tcl_NextHashEntry(&search);
                }
                if (bucketPtr->lock) {
                    Sp_RecursiveMutexFinalize(&bucketPtr->lock);
                }
                SvFinalizeContainers(bucketPtr);
                Tcl_DeleteHashTable(&bucketPtr->handles);