Tcl package Thread source code

Check-in [a0e46ee19d]
Login

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

Overview
Comment:Don't bother Tcl 9.0 compatibility, doesn't work for thread 2.8 anyway.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | thread-2-8-branch
Files: files | file ages | folders
SHA3-256: a0e46ee19d0f460df2112315663fddabde2f827a0052e4acaf432d19458090d7
User & Date: jan.nijtmans 2019-07-03 09:49:13.791
Context
2019-07-03
11:12
Make keyedListType MODULE_SCOPE check-in: 64888f72a9 user: jan.nijtmans tags: thread-2-8-branch
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:38
Make everything compile with a C++ compiler check-in: 98e6ef4220 user: jan.nijtmans tags: thread-2-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/threadSvListCmd.c.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#include "threadSvCmd.h"
#include "threadSvListCmd.h"

#if TCL_MAJOR_VERSION > 8
#define tclSizeT size_t
#elif defined(USE_TCL_STUBS)
#define tclSizeT int
/*  Little hack to eliminate the need for "tclInt.h" here:
    Just copy a small portion of TclIntStubs, just
    enough to make it work */
typedef struct TclIntStubs {
    int magic;
    void *hooks;
    void (*dummy[34]) (void); /* dummy entries 0-33, not used */







<
<
|
<







8
9
10
11
12
13
14


15

16
17
18
19
20
21
22
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#include "threadSvCmd.h"
#include "threadSvListCmd.h"



#if defined(USE_TCL_STUBS)

/*  Little hack to eliminate the need for "tclInt.h" here:
    Just copy a small portion of TclIntStubs, just
    enough to make it work */
typedef struct TclIntStubs {
    int magic;
    void *hooks;
    void (*dummy[34]) (void); /* dummy entries 0-33, not used */
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
SvLpopObjCmd (
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int ret, off, llen, iarg = 0;
    tclSizeT index = 0;
    Tcl_Obj *elPtr = NULL;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lpop array key ?index?
     *          $list lpop ?index?







|







149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
SvLpopObjCmd (
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int ret, off, llen, iarg = 0;
    int index = 0;
    Tcl_Obj *elPtr = NULL;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lpop array key ?index?
     *          $list lpop ?index?
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
    }
    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;
    }








|







180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    }
    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;
    }

232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
SvLpushObjCmd (
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int off, ret, flg, llen;
    tclSizeT index = 0;
    Tcl_Obj *args[1];
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lpush array key element ?index?
     *          $list lpush element ?index?







|







229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
SvLpushObjCmd (
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int off, ret, flg, llen;
    int index = 0;
    Tcl_Obj *args[1];
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lpush array key element ?index?
     *          $list lpush element ?index?
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    const char *firstArg;
    size_t argLen;
    int ret, off, llen, ndel, nargs, i, j;
    tclSizeT first, last;
    Tcl_Obj **args = NULL;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lreplace array key first last ?element ...?
     *          $list lreplace first last ?element ...?







|







364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    const char *firstArg;
    size_t argLen;
    int ret, off, llen, ndel, nargs, i, j;
    int first, last;
    Tcl_Obj **args = NULL;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lreplace array key first last ?element ...?
     *          $list lreplace first last ?element ...?
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
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







|
|







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
static int
SvLrangeObjCmd(
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int ret, off, llen, nargs, j;
    int first, last, i;
    Tcl_Obj **elPtrs, **args;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lrange array key first last
     *          $list lrange first last
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
SvLinsertObjCmd(
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int off, ret, flg, llen, nargs, i, j;
    tclSizeT index = 0;
    Tcl_Obj **args;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::linsert array key index element ?element ...?
     *          $list linsert element ?element ...?







|







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
SvLinsertObjCmd(
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    int off, ret, flg, llen, nargs, i, j;
    int index = 0;
    Tcl_Obj **args;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::linsert array key index element ?element ...?
     *          $list linsert element ?element ...?
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
    }
    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]);
    }
    ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, nargs, args);
    if (ret != TCL_OK) {
        for (i = off + 1, j = 0; i < objc; i++, j++) {







|







577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
    }
    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]);
    }
    ret = Tcl_ListObjReplace(interp, svObj->tclObj, index, 0, nargs, args);
    if (ret != TCL_OK) {
        for (i = off + 1, j = 0; i < objc; i++, j++) {
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    Tcl_Obj **elPtrs;
    int ret, off, llen;
    tclSizeT index;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lindex array key index
     *          $list lindex index
     */







|







780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
    ClientData arg,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
) {
    Tcl_Obj **elPtrs;
    int ret, off, llen;
    int index;
    Container *svObj = (Container*)arg;

    /*
     * Syntax:
     *          tsv::lindex array key index
     *          $list lindex index
     */
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
    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);







|







805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
    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);
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
     Tcl_Interp *interp,    /* Tcl interpreter */
     Tcl_Obj *listPtr,      /* Pointer to the list being modified */
     int indexCount,        /* Number of index args */
     Tcl_Obj **indexArray,
     Tcl_Obj *valuePtr      /* Value arg to 'lset' */
) {
    int elemCount, result, i;
    tclSizeT index;
    Tcl_Obj **elemPtrs, *chainPtr, *subListPtr;

    /*
     * Determine whether the index arg designates a list
     * or a single index.
     */








|







947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
     Tcl_Interp *interp,    /* Tcl interpreter */
     Tcl_Obj *listPtr,      /* Pointer to the list being modified */
     int indexCount,        /* Number of index args */
     Tcl_Obj **indexArray,
     Tcl_Obj *valuePtr      /* Value arg to 'lset' */
) {
    int elemCount, result, i;
    int index;
    Tcl_Obj **elemPtrs, *chainPtr, *subListPtr;

    /*
     * Determine whether the index arg designates a list
     * or a single index.
     */

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







|










|







1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
            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 + 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.