Tcl package Thread source code

Check-in [7120359506]
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:Merge 2.8 branch. Use TCL_INDEX_NONE as appropriate
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 7120359506fd91fbf7bef38f71afc68faeea888945d5390096a2dd1f2ca28594
User & Date: jan.nijtmans 2019-07-03 10:43:16
Context
2019-07-03
11:13
Merge 2.8 branch check-in: b046c2b131 user: jan.nijtmans tags: trunk
10:53
Merge trunk check-in: d07114f217 user: jan.nijtmans tags: novem
10:43
Merge 2.8 branch. Use TCL_INDEX_NONE as appropriate check-in: 7120359506 user: jan.nijtmans tags: trunk
09:49
Don't bother Tcl 9.0 compatibility, doesn't work for thread 2.8 anyway. check-in: a0e46ee19d user: jan.nijtmans tags: thread-2-8-branch
2019-07-02
13:44
Merge 2.8 branch check-in: b5cc0241a8 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclThreadInt.h.

51
52
53
54
55
56
57




58
59
60
61
62
63
64
#ifdef NS_AOLSERVER
# include <ns.h>
# if !defined(NS_MAJOR_VERSION) || NS_MAJOR_VERSION < 4
#  error "unsupported NaviServer/AOLserver version"
# endif
#endif





/*
 * Allow for some command names customization.
 * Only thread:: and tpool:: are handled here.
 * Shared variable commands are more complicated.
 * Look into the threadSvCmd.h for more info.
 */






>
>
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#ifdef NS_AOLSERVER
# include <ns.h>
# if !defined(NS_MAJOR_VERSION) || NS_MAJOR_VERSION < 4
#  error "unsupported NaviServer/AOLserver version"
# endif
#endif

#ifndef TCL_INDEX_NONE
# define TCL_INDEX_NONE	(-1)
#endif

/*
 * Allow for some command names customization.
 * Only thread:: and tpool:: are handled here.
 * Shared variable commands are more complicated.
 * Look into the threadSvCmd.h for more info.
 */

Changes to generic/threadSvListCmd.c.

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
...
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
...
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
....
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
    }
    if (iarg) {
        ret = Tcl_GetIntForIndex(interp, objv[iarg], llen-1, &index);
        if (ret != TCL_OK) {
            goto cmd_err;
        }
    }
    if (index < 0 || index >= llen) {
        goto cmd_ok; /* Ignore out-of bounds, like Tcl does */
    }
    ret = Tcl_ListObjIndex(interp, svObj->tclObj, index, &elPtr);
    if (ret != TCL_OK) {
        goto cmd_err;
    }

................................................................................
        goto cmd_err;
    }
    if ((objc - off) == 2) {
        ret = Tcl_GetIntForIndex(interp, objv[off+1], llen, &index);
        if (ret != TCL_OK) {
            goto cmd_err;
        }
        if (index < 0) {
            index = 0;
        } else if (index > llen) {
            index = llen;
        }
    }

    args[0] = Sv_DuplicateObj(objv[off]);
    ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, 1, args);
    if (ret != TCL_OK) {
................................................................................
    ret = Tcl_GetIntForIndex(interp, objv[off+1], llen-1, &last);
    if (ret != TCL_OK) {
        goto cmd_err;
    }

    firstArg = Tcl_GetString(objv[off]);
    argLen = objv[off]->length;
    if (first < 0)  {
        first = 0;
    }
    if (llen && first >= llen && strncmp(firstArg, "end", argLen)) {
        Tcl_AppendResult(interp, "list doesn't have element ", firstArg, NULL);
        goto cmd_err;
    }
    if (last >= llen) {
        last = llen - 1;
    }
    if (first <= last) {
        ndel = last - first + 1;
    } else {
        ndel = 0;
    }

    nargs = objc - (off + 2);
    if (nargs) {
................................................................................
static int
SvLrangeObjCmd(
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int ret, off, llen, nargs, i, j;
    tclSizeT first, last;
    Tcl_Obj **elPtrs, **args;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lrange array key first last
     *          $list lrange first last
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off+1], llen-1, &last);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if (first < 0)  {
        first = 0;
    }
    if (last >= llen) {
        last = llen - 1;
    }
    if (first > last) {
        goto cmd_ok;
    }

    nargs = last - first + 1;
    args  = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
    for (i = first, j = 0; i <= last; i++, j++) {
        args[j] = Sv_DuplicateObj(elPtrs[i]);
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off], llen, &index);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if (index < 0) {
        index = 0;
    } else if (index > llen) {
        index = llen;
    }

    nargs = objc - (off + 1);
    args  = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
    for (i = off + 1, j = 0; i < objc; i++, j++) {
         args[j] = Sv_DuplicateObj(objv[i]);
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off], llen-1, &index);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if (index >= 0 && index < llen) {
        Tcl_SetObjResult(interp, Sv_DuplicateObj(elPtrs[index]));
    }

    return Sv_PutContainer(interp, svObj, SV_UNCHANGED);

 cmd_err:
    return Sv_PutContainer(interp, svObj, SV_ERROR);
................................................................................
            break;
        }

        /*
         * Check that the index is in range.
         */

        if (index < 0 || index >= elemCount) {
            Tcl_SetObjResult(interp,
                             Tcl_NewStringObj("list index out of range", -1));
            result = TCL_ERROR;
            break;
        }

        /*
         * Break the loop after extracting the innermost sublist
         */

        if (i >= (indexCount - 1)) {
            result = TCL_OK;
            break;
        }

        /*
         * Extract the appropriate sublist and chain it onto the linked
         * list of Tcl_Obj's whose string reps must be spoilt.






|







 







|

|







 







|


|



|


|







 







|
|







 







|


|


|







 







|

|







 







|







 







|










|







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
...
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
...
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
...
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
...
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
....
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
    }
    if (iarg) {
        ret = Tcl_GetIntForIndex(interp, objv[iarg], llen-1, &index);
        if (ret != TCL_OK) {
            goto cmd_err;
        }
    }
    if ((index < 0) || (index >= (tclSizeT)llen)) {
        goto cmd_ok; /* Ignore out-of bounds, like Tcl does */
    }
    ret = Tcl_ListObjIndex(interp, svObj->tclObj, index, &elPtr);
    if (ret != TCL_OK) {
        goto cmd_err;
    }

................................................................................
        goto cmd_err;
    }
    if ((objc - off) == 2) {
        ret = Tcl_GetIntForIndex(interp, objv[off+1], llen, &index);
        if (ret != TCL_OK) {
            goto cmd_err;
        }
        if ((index == TCL_INDEX_NONE) || (index < 0)) {
            index = 0;
        } else if (index > (tclSizeT)llen) {
            index = llen;
        }
    }

    args[0] = Sv_DuplicateObj(objv[off]);
    ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, 1, args);
    if (ret != TCL_OK) {
................................................................................
    ret = Tcl_GetIntForIndex(interp, objv[off+1], llen-1, &last);
    if (ret != TCL_OK) {
        goto cmd_err;
    }

    firstArg = Tcl_GetString(objv[off]);
    argLen = objv[off]->length;
    if ((first == TCL_INDEX_NONE) || (first < 0))  {
        first = 0;
    }
    if (llen && first >= (tclSizeT)llen && strncmp(firstArg, "end", argLen)) {
        Tcl_AppendResult(interp, "list doesn't have element ", firstArg, NULL);
        goto cmd_err;
    }
    if (last + 1 >= (tclSizeT)llen + 1) {
        last = llen - 1;
    }
    if (first + 1 <= last + 1) {
        ndel = last - first + 1;
    } else {
        ndel = 0;
    }

    nargs = objc - (off + 2);
    if (nargs) {
................................................................................
static int
SvLrangeObjCmd(
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int ret, off, llen, nargs, j;
    tclSizeT first, last, i;
    Tcl_Obj **elPtrs, **args;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lrange array key first last
     *          $list lrange first last
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off+1], llen-1, &last);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if ((first == TCL_INDEX_NONE) || (first < 0))  {
        first = 0;
    }
    if (last + 1 >= (tclSizeT)llen + 1) {
        last = llen - 1;
    }
    if (first + 1 > last + 1) {
        goto cmd_ok;
    }

    nargs = last - first + 1;
    args  = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
    for (i = first, j = 0; i <= last; i++, j++) {
        args[j] = Sv_DuplicateObj(elPtrs[i]);
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off], llen, &index);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if ((index == TCL_INDEX_NONE) || (index < 0)) {
        index = 0;
    } else if (index > (tclSizeT)llen) {
        index = llen;
    }

    nargs = objc - (off + 1);
    args  = (Tcl_Obj**)ckalloc(nargs * sizeof(Tcl_Obj*));
    for (i = off + 1, j = 0; i < objc; i++, j++) {
         args[j] = Sv_DuplicateObj(objv[i]);
................................................................................
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    ret = Tcl_GetIntForIndex(interp, objv[off], llen-1, &index);
    if (ret != TCL_OK) {
        goto cmd_err;
    }
    if ((index >= 0) && index < (tclSizeT)llen) {
        Tcl_SetObjResult(interp, Sv_DuplicateObj(elPtrs[index]));
    }

    return Sv_PutContainer(interp, svObj, SV_UNCHANGED);

 cmd_err:
    return Sv_PutContainer(interp, svObj, SV_ERROR);
................................................................................
            break;
        }

        /*
         * Check that the index is in range.
         */

        if ((index < 0) || index >= (tclSizeT)elemCount) {
            Tcl_SetObjResult(interp,
                             Tcl_NewStringObj("list index out of range", -1));
            result = TCL_ERROR;
            break;
        }

        /*
         * Break the loop after extracting the innermost sublist
         */

        if (i + 1 >= indexCount) {
            result = TCL_OK;
            break;
        }

        /*
         * Extract the appropriate sublist and chain it onto the linked
         * list of Tcl_Obj's whose string reps must be spoilt.