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 | SQL archive |
| Timelines: | family | ancestors | descendants | both | thread-2-8-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
a0e46ee19d0f460df2112315663fddab |
| User & Date: | jan.nijtmans 2019-07-03 09:49:13 |
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
Changes to generic/threadSvListCmd.c.
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ... 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 ... 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 ... 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 ... 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 ... 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 ... 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 ... 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 ... 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 ... 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 ... 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 .... 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 |
* 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 */ ................................................................................ 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? ................................................................................ } 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; } ................................................................................ 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? ................................................................................ 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 ...? ................................................................................ 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 ................................................................................ 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 ...? ................................................................................ } 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++) { ................................................................................ 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 */ ................................................................................ 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); ................................................................................ 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. */ ................................................................................ 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. |
< < | < | | | | | | | | | | | | | |
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 ... 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 ... 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 ... 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 ... 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 ... 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 ... 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 ... 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 ... 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 ... 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 ... 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 .... 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 |
* 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 */
................................................................................
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?
................................................................................
}
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;
}
................................................................................
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?
................................................................................
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 ...?
................................................................................
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
................................................................................
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 ...?
................................................................................
}
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++) {
................................................................................
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
*/
................................................................................
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);
................................................................................
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.
*/
................................................................................
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.
|