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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/threadSvCmd.c.

   112    112   
   113    113   static Array* CreateArray(Bucket*, const char*);
   114    114   static Array* LockArray(Tcl_Interp*, const char*, int);
   115    115   
   116    116   static int ReleaseContainer(Tcl_Interp*, Container*, int);
   117    117   static int DeleteContainer(Container*);
   118    118   static int FlushArray(Array*);
   119         -static int DeleteArray(Array*);
          119  +static int DeleteArray(Tcl_Interp *, Array*);
   120    120   
   121    121   static void SvAllocateContainers(Bucket*);
   122    122   static void SvRegisterStdCommands(void);
   123    123   
   124    124   #ifdef SV_FINALIZE
   125    125   static void SvFinalizeContainers(Bucket*);
   126    126   static void SvFinalize(ClientData);
................................................................................
   832    832    * Side effects:
   833    833    *      Memory gets reclaimed.
   834    834    *
   835    835    *-----------------------------------------------------------------------------
   836    836    */
   837    837   
   838    838   static int
   839         -DeleteArray(Array *arrayPtr)
          839  +UnbindArray(Tcl_Interp *interp, Array *arrayPtr)
          840  +{
          841  +    PsStore *psPtr = arrayPtr->psPtr;
          842  +    if (arrayPtr->bindAddr) {
          843  +        ckfree(arrayPtr->bindAddr);
          844  +        arrayPtr->bindAddr = NULL;
          845  +    }
          846  +    if (psPtr) {
          847  +        if (psPtr->psClose(psPtr->psHandle) == -1) {
          848  +            if (interp) {
          849  +                const char *err = psPtr->psError(psPtr->psHandle);
          850  +                Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1));
          851  +            }
          852  +            return TCL_ERROR;
          853  +        }
          854  +        ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
          855  +        arrayPtr->psPtr = NULL;
          856  +    }
          857  +    return TCL_OK;
          858  +}
          859  +
          860  +static int
          861  +DeleteArray(Tcl_Interp *interp, Array *arrayPtr)
   840    862   {
   841    863       if (FlushArray(arrayPtr) == -1) {
   842    864           return TCL_ERROR;
   843    865       }
   844    866       if (arrayPtr->psPtr) {
   845         -        PsStore *psPtr = arrayPtr->psPtr;
   846         -        if (psPtr->psClose(psPtr->psHandle) == -1) {
          867  +        if (UnbindArray(interp, arrayPtr) != TCL_OK) {
   847    868               return TCL_ERROR;
   848         -        }
   849         -        ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
   850         -    }
   851         -    if (arrayPtr->bindAddr) {
   852         -        ckfree(arrayPtr->bindAddr);
          869  +        };
   853    870       }
   854    871       if (arrayPtr->entryPtr) {
   855    872           Tcl_DeleteHashEntry(arrayPtr->entryPtr);
   856    873       }
   857    874   
   858    875       Tcl_DeleteHashTable(&arrayPtr->vars);
   859    876       ckfree((char*)arrayPtr);
................................................................................
  1377   1394                   hPtr = Tcl_CreateHashEntry(&arrayPtr->vars, key, &new);
  1378   1395                   Tcl_SetHashValue(hPtr, CreateContainer(arrayPtr, hPtr, tclObj));
  1379   1396                   psPtr->psFree(psPtr->psHandle, val);
  1380   1397               } while (!psPtr->psNext(psPtr->psHandle, &key, &val, &len));
  1381   1398           }
  1382   1399   
  1383   1400       } else if (index == AUNBIND) {
  1384         -        if (arrayPtr && arrayPtr->psPtr) {
  1385         -            PsStore *psPtr = arrayPtr->psPtr;
  1386         -            if (psPtr->psClose(psPtr->psHandle) == -1) {
  1387         -                const char *err = psPtr->psError(psPtr->psHandle);
  1388         -                Tcl_SetObjResult(interp, Tcl_NewStringObj(err, -1));
  1389         -                ret = TCL_ERROR;
  1390         -                goto cmdExit;
  1391         -            }
  1392         -            ckfree((char*)arrayPtr->psPtr), arrayPtr->psPtr = NULL;
  1393         -        } else {
         1401  +        if (!arrayPtr || !arrayPtr->psPtr) {
  1394   1402               Tcl_AppendResult(interp, "shared variable is not bound", NULL);
  1395   1403               ret = TCL_ERROR;
  1396   1404               goto cmdExit;
         1405  +        }
         1406  +        if (UnbindArray(interp, arrayPtr) != TCL_OK) {
         1407  +            ret = TCL_ERROR;
         1408  +            goto cmdExit;
  1397   1409           }
  1398   1410       }
  1399   1411   
  1400   1412    cmdExit:
  1401   1413       if (arrayPtr) {
  1402   1414           UnlockArray(arrayPtr);
  1403   1415       }
................................................................................
  1442   1454       arrayPtr  = LockArray(interp, arrayName, 0);
  1443   1455   
  1444   1456       if (arrayPtr == NULL) {
  1445   1457           return TCL_ERROR;
  1446   1458       }
  1447   1459       if (objc == 2) {
  1448   1460           UnlockArray(arrayPtr);
  1449         -        if (DeleteArray(arrayPtr) != TCL_OK) {
         1461  +        if (DeleteArray(interp, arrayPtr) != TCL_OK) {
  1450   1462               return TCL_ERROR;
  1451   1463           }
  1452   1464       } else {
  1453   1465           for (ii = 2; ii < objc; ii++) {
  1454   1466               const char *key = Tcl_GetString(objv[ii]);
  1455   1467               Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&arrayPtr->vars, key);
  1456   1468               if (hPtr) {
................................................................................
  2348   2360           if (buckets != NULL) {
  2349   2361               for (i = 0; i < NUMBUCKETS; ++i) {
  2350   2362                   Bucket *bucketPtr = &buckets[i];
  2351   2363                   hashPtr = Tcl_FirstHashEntry(&bucketPtr->arrays, &search);
  2352   2364                   while (hashPtr != NULL) {
  2353   2365                       Array *arrayPtr = (Array*)Tcl_GetHashValue(hashPtr);
  2354   2366                       UnlockArray(arrayPtr);
  2355         -                    DeleteArray(arrayPtr);
         2367  +                    /* unbind array before delete (avoid flush of persistent storage) */
         2368  +                    UnbindArray(NULL, arrayPtr);
         2369  +                    /* flush, delete etc. */
         2370  +                    DeleteArray(NULL, arrayPtr);
  2356   2371                       hashPtr = Tcl_NextHashEntry(&search);
  2357   2372                   }
  2358   2373                   if (bucketPtr->lock) {
  2359   2374                       Sp_RecursiveMutexFinalize(&bucketPtr->lock);
  2360   2375                   }
  2361   2376                   SvFinalizeContainers(bucketPtr);
  2362   2377                   Tcl_DeleteHashTable(&bucketPtr->handles);