Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-660 Excluding Merge-Ins
This is equivalent to a diff from 883464ea32 to 0bf637b9dc
2023-04-21
| ||
17:17 | Merge pre-TIP 660 changes from trunk. check-in: a6a4d93dd6 user: dgp tags: dgp-refactor | |
16:49 | Merge pre-TIP 660 changes from trunk. check-in: b1c433a972 user: dgp tags: novem | |
2023-04-20
| ||
16:53 | Merge 9.0 check-in: aa3e7e529f user: jan.nijtmans tags: tip-626 | |
2023-04-19
| ||
12:15 | Merge trunk [883464ea32]. check-in: b5d4c2af53 user: pooryorick tags: trunk-encodingdefaultstrict | |
03:36 | TIP 660 accepted. check-in: 1842599320 user: apnadkarni tags: trunk, main | |
02:32 | Pick up lreplace.test and lseq.test from tip-660-with-trunk-testcases Closed-Leaf check-in: 0bf637b9dc user: apnadkarni tags: tip-660 | |
02:00 | Merge trunk check-in: 5ad7c7b96d user: apnadkarni tags: tip-660 | |
2023-04-18
| ||
22:35 | In DoReadChars() reset CHANNEL_ENCODING_ERROR instead of CHANNEL_BLOCKED. check-in: 883464ea32 user: pooryorick tags: trunk, main | |
22:00 | Fix for [25cdcb7e8fb381fb]: Incomplete utf-8 sequence followed by eofchar results in failed asserti... check-in: a02c5b9f8b user: pooryorick tags: trunk, main | |
Changes to doc/AddErrInfo.3.
︙ | ︙ | |||
50 51 52 53 54 55 56 | .AP "const char" *message in For \fBTcl_AddErrorInfo\fR, this is a conventional C string to append to the \fB\-errorinfo\fR return option. For \fBTcl_AddObjErrorInfo\fR, this points to the first byte of an array of \fIlength\fR bytes containing a string to append to the \fB\-errorinfo\fR return option. This byte array may contain embedded null bytes | | | | | | | 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | .AP "const char" *message in For \fBTcl_AddErrorInfo\fR, this is a conventional C string to append to the \fB\-errorinfo\fR return option. For \fBTcl_AddObjErrorInfo\fR, this points to the first byte of an array of \fIlength\fR bytes containing a string to append to the \fB\-errorinfo\fR return option. This byte array may contain embedded null bytes unless \fIlength\fR is negative. .AP Tcl_Obj *objPtr in A message to be appended to the \fB\-errorinfo\fR return option in the form of a Tcl_Obj value. .AP Tcl_Size length in The number of bytes to copy from \fImessage\fR when appending to the \fB\-errorinfo\fR return option. If negative, all bytes up to the first null byte are used. .AP Tcl_Obj *errorObjPtr in The \fB\-errorcode\fR return option will be set to this value. .AP "const char" *element in String to record as one element of the \fB\-errorcode\fR return option. Last \fIelement\fR argument must be NULL. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .AP int lineNum The line number of a script where an error occurred. .AP "const char" *script in Pointer to first character in script containing command (must be <= command) .AP "const char" *command in Pointer to first character in command that generated the error .AP Tcl_Size commandLength in Number of bytes in command; a negative value means use all bytes up to first null byte .BE .SH DESCRIPTION .PP The \fBTcl_SetReturnOptions\fR and \fBTcl_GetReturnOptions\fR routines expose the same capabilities as the \fBreturn\fR and \fBcatch\fR commands, respectively, in the form of a C interface. .PP |
︙ | ︙ | |||
223 224 225 226 227 228 229 | \fBTcl_AddObjErrorInfo\fR is nearly identical to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR argument. This allows the \fImessage\fR string to contain embedded null bytes. This is essentially never a good idea. If the \fImessage\fR needs to contain the null character \fBU+0000\fR, Tcl's usual internal encoding rules should be used to avoid the need for a null byte. If the \fBTcl_AddObjErrorInfo\fR | | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | \fBTcl_AddObjErrorInfo\fR is nearly identical to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR argument. This allows the \fImessage\fR string to contain embedded null bytes. This is essentially never a good idea. If the \fImessage\fR needs to contain the null character \fBU+0000\fR, Tcl's usual internal encoding rules should be used to avoid the need for a null byte. If the \fBTcl_AddObjErrorInfo\fR interface is used at all, it should be with a negative \fIlength\fR value. .PP The procedure \fBTcl_SetObjErrorCode\fR is used to set the \fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR built up by the caller. \fBTcl_SetObjErrorCode\fR is typically invoked just before returning an error. If an error is returned without calling \fBTcl_SetObjErrorCode\fR or |
︙ | ︙ |
Changes to doc/ByteArrObj.3.
︙ | ︙ | |||
30 31 32 33 34 35 36 | unsigned char * \fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR) .SH ARGUMENTS .AS "const unsigned char" *numBytesPtr in/out .AP "const unsigned char" *bytes in The array of bytes used to initialize or set a byte-array value. May be NULL even if \fInumBytes\fR is non-zero. | | | | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | unsigned char * \fBTcl_SetByteArrayLength\fR(\fIobjPtr, numBytes\fR) .SH ARGUMENTS .AS "const unsigned char" *numBytesPtr in/out .AP "const unsigned char" *bytes in The array of bytes used to initialize or set a byte-array value. May be NULL even if \fInumBytes\fR is non-zero. .AP Tcl_Size numBytes in The number of bytes in the array. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetByteArrayObj\fR, this points to an unshared value to be overwritten by a byte-array value. For \fBTcl_GetBytesFromObj\fR, \fBTcl_GetByteArrayFromObj\fR and \fBTcl_SetByteArrayLength\fR, this points to the value from which to extract an array of bytes. .AP Tcl_Interp *interp in Interpreter to use for error reporting. .AP "Tcl_Size \&| int" *numBytesPtr out Points to space where the number of bytes in the array may be written. Caller may pass NULL when it does not need this information. .BE .SH DESCRIPTION .PP These routines are used to create, modify, store, transfer, and retrieve |
︙ | ︙ | |||
130 131 132 133 134 135 136 | has not been disturbed. The pointer may be used to overwrite the byte contents of the internal representation, so long as the value is unshared and any string representation is invalidated. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type | | | | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | has not been disturbed. The pointer may be used to overwrite the byte contents of the internal representation, so long as the value is unshared and any string representation is invalidated. .PP On success, both \fBTcl_GetBytesFromObj\fR and \fBTcl_GetByteArrayFromObj\fR write the number of bytes in the byte-array value of \fIobjPtr\fR to the space pointed to by \fInumBytesPtr\fR. This space may be of type \fBTcl_Size\fR or of type \fBint\fR. It is recommended that callers provide a \fBTcl_Size\fR space for this purpose. If the caller provides only an \fBint\fR space and the number of bytes in the byte-array value of \fIobjPtr\fR is greater than \fBINT_MAX\fR, the routine will fail due to being unable to correctly report the byte-array size to the caller. The ability to provide an \fBint\fR space is best considered a migration aid for codebases constrained to continue operating with Tcl releases older than 8.7. .PP |
︙ | ︙ |
Changes to doc/Class.3.
︙ | ︙ | |||
77 78 79 80 81 82 83 | .AP "const char" *name in The name of the object to create, or NULL if a new unused name is to be automatically selected. .AP "const char" *nsName in The name of the namespace to create for the object's private use, or NULL if a new unused name is to be automatically selected. The namespace must not already exist. | | | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | .AP "const char" *name in The name of the object to create, or NULL if a new unused name is to be automatically selected. .AP "const char" *nsName in The name of the namespace to create for the object's private use, or NULL if a new unused name is to be automatically selected. The namespace must not already exist. .AP Tcl_Size objc in The number of elements in the \fIobjv\fR array. .AP "Tcl_Obj *const" *objv in The arguments to the command to create the instance of the class. .AP Tcl_Size skip in The number of arguments at the start of the argument array, \fIobjv\fR, that are not arguments to any constructors. This allows the generation of correct error messages even when complicated calling patterns are used (e.g., via the \fBnext\fR command). .AP Tcl_ObjectMetadataType *metaTypePtr in The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or retrieved with \fBTcl_ClassGetMetadata\fR. |
︙ | ︙ |
Changes to doc/Concat.3.
︙ | ︙ | |||
14 15 16 17 18 19 20 | .nf \fB#include <tcl.h>\fR .sp const char * \fBTcl_Concat\fR(\fIargc, argv\fR) .SH ARGUMENTS .AS "const char *const" argv[] | | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | .nf \fB#include <tcl.h>\fR .sp const char * \fBTcl_Concat\fR(\fIargc, argv\fR) .SH ARGUMENTS .AS "const char *const" argv[] .AP Tcl_Size argc in Number of strings. .AP "const char *const" argv[] in Array of strings to concatenate. Must have \fIargc\fR entries. .BE .SH DESCRIPTION .PP |
︙ | ︙ |
Changes to doc/CrtAlias.3.
︙ | ︙ | |||
65 66 67 68 69 70 71 | below). .AP "const char" *childCmd in Name of source command for alias. .AP Tcl_Interp *targetInterp in Interpreter that contains the target command for an alias. .AP "const char" *targetCmd in Name of target command for alias in \fItargetInterp\fR. | | | | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | below). .AP "const char" *childCmd in Name of source command for alias. .AP Tcl_Interp *targetInterp in Interpreter that contains the target command for an alias. .AP "const char" *targetCmd in Name of target command for alias in \fItargetInterp\fR. .AP Tcl_Size argc in Count of additional arguments to pass to the alias command. .AP "const char *const" *argv in Vector of strings, the additional arguments to pass to the alias command. This storage is owned by the caller. .AP Tcl_Size objc in Count of additional value arguments to pass to the aliased command. .AP Tcl_Obj **objv in Vector of Tcl_Obj structures, the additional value arguments to pass to the aliased command. This storage is owned by the caller. .AP Tcl_Interp **targetInterpPtr in Pointer to location to store the address of the interpreter where a target |
︙ | ︙ |
Changes to doc/CrtChannel.3.
︙ | ︙ | |||
137 138 139 140 141 142 143 | The channel to operate on. .AP int direction in \fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR means the output handle is wanted. .AP void **handlePtr out Points to the location where the desired OS-specific handle should be stored. | | | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | The channel to operate on. .AP int direction in \fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR means the output handle is wanted. .AP void **handlePtr out Points to the location where the desired OS-specific handle should be stored. .AP Tcl_Size size in The size, in bytes, of buffers to allocate in this channel. .AP int mask in An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR that indicates events that have occurred on this channel. .AP Tcl_Interp *interp in Current interpreter. (can be NULL) |
︙ | ︙ |
Changes to doc/CrtObjCmd.3.
︙ | ︙ | |||
183 184 185 186 187 188 189 | \fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR, except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. .PP .CS typedef int \fBTcl_ObjCmdProc2\fR( void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, | | | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | \fBTcl_CreateObjCommand2\fR does the same as \fBTcl_CreateObjCommand\fR, except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR. .PP .CS typedef int \fBTcl_ObjCmdProc2\fR( void *\fIclientData\fR, Tcl_Interp *\fIinterp\fR, ptrdiff_t \fIobjc\fR, Tcl_Obj *const \fIobjv\fR[]); .CE .PP \fBTcl_DeleteCommand\fR deletes a command from a command interpreter. Once the call completes, attempts to invoke \fIcmdName\fR in \fIinterp\fR will result in errors. If \fIcmdName\fR is not bound as a command in \fIinterp\fR then |
︙ | ︙ |
Changes to doc/CrtTrace.3.
︙ | ︙ | |||
25 26 27 28 29 30 31 | \fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR) .sp \fBTcl_DeleteTrace\fR(\fIinterp, trace\fR) .SH ARGUMENTS .AS Tcl_CmdObjTraceDeleteProc *deleteProc .AP Tcl_Interp *interp in Interpreter containing command to be traced or untraced. | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | \fBTcl_CreateObjTrace2\fR(\fIinterp, level, flags, objProc2, clientData, deleteProc\fR) .sp \fBTcl_DeleteTrace\fR(\fIinterp, trace\fR) .SH ARGUMENTS .AS Tcl_CmdObjTraceDeleteProc *deleteProc .AP Tcl_Interp *interp in Interpreter containing command to be traced or untraced. .AP Tcl_Size level in Only commands at or below this nesting level will be traced unless 0 is specified. 1 means top-level commands only, 2 means top-level commands or those that are invoked as immediate consequences of executing top-level commands (procedure bodies, bracketed commands, etc.) and so on. A value of 0 means that commands at any level are traced. .AP int flags in |
︙ | ︙ | |||
84 85 86 87 88 89 90 | \fIobjProc2\fR should have arguments and result that match the type, \fBTcl_CmdObjTraceProc2\fR: .PP .CS typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, | | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | \fIobjProc2\fR should have arguments and result that match the type, \fBTcl_CmdObjTraceProc2\fR: .PP .CS typedef int \fBTcl_CmdObjTraceProc2\fR( \fBvoid *\fR \fIclientData\fR, \fBTcl_Interp\fR* \fIinterp\fR, ptrdiff_t \fIlevel\fR, const char *\fIcommand\fR, \fBTcl_Command\fR \fIcommandToken\fR, ptrdiff_t \fIobjc\fR, \fBTcl_Obj\fR *const \fIobjv\fR[]); .CE .PP The \fIclientData\fR and \fIinterp\fR parameters are copies of the corresponding arguments given to \fBTcl_CreateTrace\fR. \fIclientData\fR typically points to an application-specific data structure that describes what to do when \fIobjProc\fR is invoked. The |
︙ | ︙ |
Changes to doc/DString.3.
︙ | ︙ | |||
22 23 24 25 26 27 28 | char * \fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR) .sp \fBTcl_DStringStartSublist\fR(\fIdsPtr\fR) .sp \fBTcl_DStringEndSublist\fR(\fIdsPtr\fR) .sp | | | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | char * \fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR) .sp \fBTcl_DStringStartSublist\fR(\fIdsPtr\fR) .sp \fBTcl_DStringEndSublist\fR(\fIdsPtr\fR) .sp Tcl_Size \fBTcl_DStringLength\fR(\fIdsPtr\fR) .sp char * \fBTcl_DStringValue\fR(\fIdsPtr\fR) .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp |
︙ | ︙ | |||
47 48 49 50 51 52 53 | .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out Pointer to structure that is used to manage a dynamic string. .AP "const char" *bytes in Pointer to characters to append to dynamic string. .AP "const char" *element in Pointer to characters to append as list element to dynamic string. | | | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | .AS Tcl_DString newLength in/out .AP Tcl_DString *dsPtr in/out Pointer to structure that is used to manage a dynamic string. .AP "const char" *bytes in Pointer to characters to append to dynamic string. .AP "const char" *element in Pointer to characters to append as list element to dynamic string. .AP Tcl_Size length in Number of bytes from \fIbytes\fR to add to dynamic string. If negative, add all characters up to null terminating character. .AP Tcl_Size newLength in New length for dynamic string, not including null terminating character. .AP Tcl_Interp *interp in/out Interpreter whose result is to be set from or moved to the dynamic string. .BE |
︙ | ︙ |
Changes to doc/DetachPids.3.
︙ | ︙ | |||
18 19 20 21 22 23 24 | .sp \fBTcl_ReapDetachedProcs\fR() .sp Tcl_Pid \fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR) .SH ARGUMENTS .AS Tcl_Pid *statusPtr out | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | .sp \fBTcl_ReapDetachedProcs\fR() .sp Tcl_Pid \fBTcl_WaitPid\fR(\fIpid, statusPtr, options\fR) .SH ARGUMENTS .AS Tcl_Pid *statusPtr out .AP Tcl_Size numPids in Number of process ids contained in the array pointed to by \fIpidPtr\fR. .AP int *pidPtr in Address of array containing \fInumPids\fR process ids. .AP Tcl_Pid pid in The id of the process (pipe) to wait for. .AP int *statusPtr out The result of waiting on a process (pipe). Either 0 or ECHILD. |
︙ | ︙ |
Changes to doc/DictObj.3.
︙ | ︙ | |||
66 67 68 69 70 71 72 | dictionary value (or sub-value, in the case of \fBTcl_DictObjPutKeyList\fR.) .AP Tcl_Obj **valuePtrPtr out Points to a variable that will have the value from a key/value pair placed within it. For \fBTcl_DictObjFirst\fR and \fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is not interested in the value. | | | | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | dictionary value (or sub-value, in the case of \fBTcl_DictObjPutKeyList\fR.) .AP Tcl_Obj **valuePtrPtr out Points to a variable that will have the value from a key/value pair placed within it. For \fBTcl_DictObjFirst\fR and \fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is not interested in the value. .AP "Tcl_Size \&| int" *sizePtr out Points to a variable that will have the number of key/value pairs contained within the dictionary placed within it. .AP Tcl_DictSearch *searchPtr in/out Pointer to record to use to keep track of progress in enumerating all key/value pairs in a dictionary. The contents of the record will be initialized by the call to \fBTcl_DictObjFirst\fR. If the enumerating is to be terminated before all values in the dictionary have been returned, the search record \fImust\fR be passed to \fBTcl_DictObjDone\fR to enable the internal locks to be released. .AP int *donePtr out Points to a variable that will have a non-zero value written into it when the enumeration of the key/value pairs in a dictionary has completed, and a zero otherwise. .AP Tcl_Size keyc in Indicates the number of keys that will be supplied in the \fIkeyv\fR array. .AP "Tcl_Obj *const" *keyv in Array of \fIkeyc\fR pointers to values that \fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will use to locate the key/value pair to manipulate within the sub-dictionaries of the main dictionary value passed to them. |
︙ | ︙ |
Changes to doc/Encoding.3.
︙ | ︙ | |||
21 22 23 24 25 26 27 | .sp int \fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR) .sp char * \fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp | | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | .sp int \fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR) .sp char * \fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp int \fBTcl_ExternalToUtfDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR) .sp char * \fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR) .sp int \fBTcl_UtfToExternalDStringEx\fR(\fIinterp, encoding, src, srcLen, flags, dstPtr, errorIdxPtr\fR) .sp int \fBTcl_ExternalToUtf\fR(\fIinterp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR) .sp int \fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR) .sp const char * \fBTcl_GetEncodingName\fR(\fIencoding\fR) .sp Tcl_Size \fBTcl_GetEncodingNulLength\fR(\fIencoding\fR) .sp int \fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR) .sp const char * \fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR) |
︙ | ︙ | |||
82 83 84 85 86 87 88 | .AP "const char" *src in For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the specified encoding that are to be converted to UTF-8. For the \fBTcl_UtfToExternal\fR function, an array of UTF-8 characters to be converted to the specified encoding. .AP "const TCHAR" *tsrc in An array of Windows TCHAR characters to convert to UTF-8. | | | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | .AP "const char" *src in For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the specified encoding that are to be converted to UTF-8. For the \fBTcl_UtfToExternal\fR function, an array of UTF-8 characters to be converted to the specified encoding. .AP "const TCHAR" *tsrc in An array of Windows TCHAR characters to convert to UTF-8. .AP Tcl_Size srcLen in Length of \fIsrc\fR or \fItsrc\fR in bytes. If the length is negative, the encoding-specific length of the string is used. .AP Tcl_DString *dstPtr out Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted result will be stored. .AP int flags in This is a bit mask passed in to control the operation of the encoding functions. |
︙ | ︙ | |||
343 344 345 346 347 348 349 | .CS typedef struct Tcl_EncodingType { const char *\fIencodingName\fR; Tcl_EncodingConvertProc *\fItoUtfProc\fR; Tcl_EncodingConvertProc *\fIfromUtfProc\fR; Tcl_EncodingFreeProc *\fIfreeProc\fR; void *\fIclientData\fR; | | | 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 | .CS typedef struct Tcl_EncodingType { const char *\fIencodingName\fR; Tcl_EncodingConvertProc *\fItoUtfProc\fR; Tcl_EncodingConvertProc *\fIfromUtfProc\fR; Tcl_EncodingFreeProc *\fIfreeProc\fR; void *\fIclientData\fR; Tcl_Size \fInullSize\fR; } \fBTcl_EncodingType\fR; .CE .PP The \fIencodingName\fR provides a string name for the encoding, by which it can be referred in other procedures such as \fBTcl_GetEncoding\fR. The \fItoUtfProc\fR refers to a callback procedure to invoke to convert text from this encoding into UTF-8. |
︙ | ︙ |
Changes to doc/Eval.3.
︙ | ︙ | |||
46 47 48 49 50 51 52 | .AP Tcl_Obj *objPtr in A Tcl value containing the script to execute. .AP int flags in OR'ed combination of flag bits that specify additional options. \fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported. .AP "const char" *fileName in Name of a file containing a Tcl script. | | | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | .AP Tcl_Obj *objPtr in A Tcl value containing the script to execute. .AP int flags in OR'ed combination of flag bits that specify additional options. \fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported. .AP "const char" *fileName in Name of a file containing a Tcl script. .AP Tcl_Size objc in The number of values in the array pointed to by \fIobjv\fR; this is also the number of words in the command. .AP Tcl_Obj **objv in Points to an array of pointers to values; each value holds the value of a single word in the command to execute. .AP int numBytes in The number of bytes in \fIscript\fR, not including any |
︙ | ︙ |
Changes to doc/FileSystem.3.
︙ | ︙ | |||
216 217 218 219 220 221 222 | The first of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *secondPtr in The second of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *listObj in The list of path elements to operate on with a \fBjoin\fR operation. | | | | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | The first of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *secondPtr in The second of two path values to compare. The value may be converted to \fBpath\fR type. .AP Tcl_Obj *listObj in The list of path elements to operate on with a \fBjoin\fR operation. .AP Tcl_Size elements in The number of elements in the \fIlistObj\fR which should be joined together. If negative, then all elements are joined. .AP Tcl_Obj **errorPtr out In the case of an error, filled with a value containing the name of the file which caused an error in the various copy/rename operations. .AP int index in The index of the attribute in question. .AP Tcl_Obj *objPtr in The value to set in the operation. |
︙ | ︙ | |||
265 266 267 268 269 270 271 | used to set those values for a given file. .AP "const char" *modeString in Specifies how the file is to be accessed. May have any of the values allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. | | | | 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 | used to set those values for a given file. .AP "const char" *modeString in Specifies how the file is to be accessed. May have any of the values allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. .AP "ptrdiff_t \&| int" *lenPtr out If non-NULL, filled with the number of elements in the split path. .AP Tcl_Obj *basePtr in The base path on to which to join the given elements. May be NULL. .AP Tcl_Size objc in The number of elements in \fIobjv\fR. .AP "Tcl_Obj *const" objv[] in The elements to join to the given base path. .AP Tcl_Obj *linkNamePtr in The name of the link to be created or read. .AP Tcl_Obj *toPtr in What the link called \fIlinkNamePtr\fR should be linked to, or NULL if |
︙ | ︙ | |||
834 835 836 837 838 839 840 | .SS "THE TCL_FILESYSTEM STRUCTURE" .PP The \fBTcl_Filesystem\fR structure contains the following fields: .PP .CS typedef struct Tcl_Filesystem { const char *\fItypeName\fR; | | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 | .SS "THE TCL_FILESYSTEM STRUCTURE" .PP The \fBTcl_Filesystem\fR structure contains the following fields: .PP .CS typedef struct Tcl_Filesystem { const char *\fItypeName\fR; Tcl_Size \fIstructureLength\fR; Tcl_FSVersion \fIversion\fR; Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR; Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR; Tcl_FSFreeInternalRepProc *\fIfreeInternalRepProc\fR; Tcl_FSInternalToNormalizedProc *\fIinternalToNormalizedProc\fR; Tcl_FSCreateInternalRepProc *\fIcreateInternalRepProc\fR; Tcl_FSNormalizePathProc *\fInormalizePathProc\fR; |
︙ | ︙ |
Changes to doc/IntObj.3.
︙ | ︙ | |||
39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | .sp int \fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) .sp int \fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR) .sp .sp \fB#include <tclTomMath.h>\fR .sp Tcl_Obj * \fBTcl_NewBignumObj\fR(\fIbigValue\fR) .sp \fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR) .sp int \fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out | > > > | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | .sp int \fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR) .sp int \fBTcl_GetWideUIntFromObj\fR(\fIinterp, objPtr, uwidePtr\fR) .sp int \fBTcl_GetSizeIntFromObj\fR(\fIinterp, objPtr, sizePtr\fR) .sp .sp \fB#include <tclTomMath.h>\fR .sp Tcl_Obj * \fBTcl_NewBignumObj\fR(\fIbigValue\fR) .sp \fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR) .sp int \fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR) .sp int \fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR) .SH ARGUMENTS .AS Tcl_WideInt doubleValue in/out .AP Tcl_Size endValue in \fBTcl_GetIntForIndex\fR will return this when the input value is "end". .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. |
︙ | ︙ | |||
79 80 81 82 83 84 85 | .AP Tcl_Interp *interp in/out When non-NULL, an error message is left here when integral value retrieval fails. .AP int *intPtr out Points to place to store the integer value retrieved from \fIobjPtr\fR. .AP long *longPtr out Points to place to store the long integer value retrieved from \fIobjPtr\fR. | | | > > | 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | .AP Tcl_Interp *interp in/out When non-NULL, an error message is left here when integral value retrieval fails. .AP int *intPtr out Points to place to store the integer value retrieved from \fIobjPtr\fR. .AP long *longPtr out Points to place to store the long integer value retrieved from \fIobjPtr\fR. .AP Tcl_Size *indexPtr out Points to place to store the Tcl_Size value retrieved from \fIobjPtr\fR. .AP Tcl_WideInt *widePtr out Points to place to store the wide integer value retrieved from \fIobjPtr\fR. .AP Tcl_WideUInt *uwidePtr out Points to place to store the unsigned wide integer value retrieved from \fIobjPtr\fR. .AP Tcl_Size *sizePtr out Points to place to store the \fBTcl_Size\fR integer value retrieved from \fIobjPtr\fR. .AP mp_int *bigValue in/out Points to a multi-precision integer structure declared by the LibTomMath library. .AP double doubleValue in Double value from which the integer part is determined and used to initialize a multi-precision integer value. .BE |
︙ | ︙ | |||
134 135 136 137 138 139 140 | \fIobjPtr\fR does not hold an index value. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent calls to the same routine more efficient. .PP The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, | | > | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | \fIobjPtr\fR does not hold an index value. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR. The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent calls to the same routine more efficient. .PP The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetSizeIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral value of the appropriate type from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might fail if \fIobjPtr\fR does not hold an integral value, or if the value exceeds the range of the target type. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, |
︙ | ︙ |
Changes to doc/Limit.3.
︙ | ︙ | |||
61 62 63 64 65 66 67 | .AS Tcl_LimitHandlerDeleteProc commandLimit in/out .AP Tcl_Interp *interp in Interpreter that the limit being managed applies to or that will have its limits checked. .AP int type in The type of limit that the operation refers to. This must be either \fBTCL_LIMIT_COMMANDS\fR or \fBTCL_LIMIT_TIME\fR. | | | 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | .AS Tcl_LimitHandlerDeleteProc commandLimit in/out .AP Tcl_Interp *interp in Interpreter that the limit being managed applies to or that will have its limits checked. .AP int type in The type of limit that the operation refers to. This must be either \fBTCL_LIMIT_COMMANDS\fR or \fBTCL_LIMIT_TIME\fR. .AP Tcl_Size commandLimit in The maximum number of commands (as reported by \fBinfo cmdcount\fR) that may be executed in the interpreter. .AP Tcl_Time *timeLimitPtr in/out A pointer to a structure that will either have the new time limit read from (\fBTcl_LimitSetTime\fR) or the current time limit written to (\fBTcl_LimitGetTime\fR). .AP int granularity in |
︙ | ︙ |
Changes to doc/LinkVar.3.
︙ | ︙ | |||
55 56 57 58 59 60 61 | In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and \fBTCL_LINK_BINARY\fR may be used. .VE "TIP 312" .sp All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and \fBTCL_LINK_BINARY\fR may be used. .VE "TIP 312" .sp All the above for both functions may be optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl variable read-only. .AP Tcl_Size size in .VS "TIP 312" The number of elements in the C array. Must be greater than zero. .VE "TIP 312" .BE .SH DESCRIPTION .PP \fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable |
︙ | ︙ |
Changes to doc/ListObj.3.
︙ | ︙ | |||
55 56 57 58 59 60 61 | an attempt will be made to convert it to one. .AP Tcl_Obj *objPtr in For \fBTcl_ListObjAppendElement\fR, points to the Tcl value that will be appended to \fIlistPtr\fR. For \fBTcl_SetListObj\fR, this points to the Tcl value that will be converted to a list value containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR. | | | | | | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | an attempt will be made to convert it to one. .AP Tcl_Obj *objPtr in For \fBTcl_ListObjAppendElement\fR, points to the Tcl value that will be appended to \fIlistPtr\fR. For \fBTcl_SetListObj\fR, this points to the Tcl value that will be converted to a list value containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR. .AP "ptrdiff_t \&| int" *objcPtr in Points to location where \fBTcl_ListObjGetElements\fR stores the number of element values in \fIlistPtr\fR. .AP Tcl_Obj ***objvPtr out A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array of pointers to the element values of \fIlistPtr\fR. .AP Tcl_Size objc in The number of Tcl values that \fBTcl_NewListObj\fR will insert into a new list value, and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR. For \fBTcl_SetListObj\fR, the number of Tcl values to insert into \fIobjPtr\fR. .AP "Tcl_Obj *const" objv[] in An array of pointers to values. \fBTcl_NewListObj\fR will insert these values into a new list value and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR. Each value will become a separate list element. .AP "ptrdiff_t \&| int" *lengthPtr out Points to location where \fBTcl_ListObjLength\fR stores the length of the list. .AP Tcl_Size index in Index of the list element that \fBTcl_ListObjIndex\fR is to return. The first element has index 0. .AP Tcl_Obj **objPtrPtr out Points to place where \fBTcl_ListObjIndex\fR is to store a pointer to the resulting list element value. .AP Tcl_Size first in Index of the starting list element that \fBTcl_ListObjReplace\fR is to replace. The list's first element has index 0. .AP Tcl_Size count in The number of elements that \fBTcl_ListObjReplace\fR is to replace. .BE .SH DESCRIPTION .PP Tcl list values have an internal representation that supports |
︙ | ︙ | |||
180 181 182 183 184 185 186 | in the address \fIobjPtrPtr\fR. If \fIlistPtr\fR does not already refer to a list value, \fBTcl_ListObjIndex\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. If the index is out of range, | | | | | 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | in the address \fIobjPtrPtr\fR. If \fIlistPtr\fR does not already refer to a list value, \fBTcl_ListObjIndex\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. If the index is out of range, that is, \fIindex\fR is negative or greater than or equal to the number of elements in the list, \fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR and returns \fBTCL_OK\fR. Otherwise it returns \fBTCL_OK\fR after storing the element's value pointer. The reference count for the list element is not incremented; the caller must do that if it needs to retain a pointer to the element. .PP \fBTcl_ListObjReplace\fR replaces zero or more elements of the list referenced by \fIlistPtr\fR with the \fIobjc\fR values in the array referenced by \fIobjv\fR. If \fIlistPtr\fR does not point to a list value, \fBTcl_ListObjReplace\fR will attempt to convert it to one; if the conversion fails, it returns \fBTCL_ERROR\fR and leaves an error message in the interpreter's result value if \fIinterp\fR is not NULL. Otherwise, it returns \fBTCL_OK\fR after replacing the values. If \fIobjv\fR is NULL, no new elements are added. If the argument \fIfirst\fR is zero or negative, it refers to the first element. If \fIfirst\fR is greater than or equal to the number of elements in the list, then no elements are deleted; the new elements are appended to the list. \fIcount\fR gives the number of elements to replace. If \fIcount\fR is zero or negative then no elements are deleted; the new elements are simply inserted before the one designated by \fIfirst\fR. \fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's old string representation. The reference counts of any elements inserted from \fIobjv\fR are incremented since the resulting list now refers to them. Similarly, the reference counts for any replaced values are decremented. |
︙ | ︙ |
Changes to doc/Method.3.
︙ | ︙ | |||
54 55 56 57 58 59 60 | .sp Tcl_Method \fBTcl_ObjectContextMethod\fR(\fIcontext\fR) .sp Tcl_Object \fBTcl_ObjectContextObject\fR(\fIcontext\fR) .sp | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | .sp Tcl_Method \fBTcl_ObjectContextMethod\fR(\fIcontext\fR) .sp Tcl_Object \fBTcl_ObjectContextObject\fR(\fIcontext\fR) .sp Tcl_Size \fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR) .SH ARGUMENTS .AS void *clientData in .AP Tcl_Interp *interp in/out The interpreter holding the object or class to create or update a method in. .AP Tcl_Object object in The object to create the method in. |
︙ | ︙ | |||
91 92 93 94 95 96 97 | when the method was created. If NULL, the \fIclientData\fR value will not be retrieved. .AP Tcl_Method method in A reference to a method to query. .AP Tcl_ObjectContext context in A reference to a method-call context. Note that client code \fImust not\fR retain a reference to a context. | | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | when the method was created. If NULL, the \fIclientData\fR value will not be retrieved. .AP Tcl_Method method in A reference to a method to query. .AP Tcl_ObjectContext context in A reference to a method-call context. Note that client code \fImust not\fR retain a reference to a context. .AP Tcl_Size objc in The number of arguments to pass to the method implementation. .AP "Tcl_Obj *const" *objv in An array of arguments to pass to the method implementation. .AP Tcl_Size skip in The number of arguments passed to the method implementation that do not represent "real" arguments. .BE .SH DESCRIPTION .PP A method is an operation carried out on an object that is associated with the object. Every method must be attached to either an object or a class; methods |
︙ | ︙ |
Changes to doc/NRE.3.
︙ | ︙ | |||
65 66 67 68 69 70 71 | Called instead of \fIproc2\fR when a trampoline is already in use. .AP void *clientData in Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR and \fIobjProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in/out Called before \fIcmdName\fR is deleted from the interpreter, allowing for command-specific cleanup. May be NULL. | | | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | Called instead of \fIproc2\fR when a trampoline is already in use. .AP void *clientData in Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR and \fIobjProc\fR. .AP Tcl_CmdDeleteProc *deleteProc in/out Called before \fIcmdName\fR is deleted from the interpreter, allowing for command-specific cleanup. May be NULL. .AP Tcl_Size objc in Number of items in \fIobjv\fR. .AP Tcl_Obj **objv in Words in the command. .AP Tcl_Obj *objPtr in A script or expression to evaluate. .AP int flags in As described for \fITcl_EvalObjv\fR. |
︙ | ︙ |
Changes to doc/Number.3.
︙ | ︙ | |||
23 24 25 26 27 28 29 | .SH ARGUMENTS .AS Tcl_Interp clientDataPtr out .AP Tcl_Interp *interp out When non-NULL, error information is recorded here when the value is not in any of the numeric formats recognized by Tcl. .AP "const char" *bytes in Points to first byte of the string value to be examined. | | | | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | .SH ARGUMENTS .AS Tcl_Interp clientDataPtr out .AP Tcl_Interp *interp out When non-NULL, error information is recorded here when the value is not in any of the numeric formats recognized by Tcl. .AP "const char" *bytes in Points to first byte of the string value to be examined. .AP Tcl_Size numBytes in The number of bytes, starting at \fIbytes\fR, that should be examined. If \fBnumBytes\fR is negative, then all bytes should be examined until the first \fBNUL\fR byte terminates examination. .AP "void *" *clientDataPtr out Points to space where a pointer value may be written through which a numeric value is available to read. .AP int *typePtr out Points to space where a value may be written reporting what type of numeric storage is available to read. |
︙ | ︙ | |||
59 60 61 62 63 64 65 | multiple-precision integer library, included with Tcl. .PP The routines \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR perform the same function. They differ only in how the arguments present the Tcl value to be examined. \fBTcl_GetNumber\fR accepts a counted string value in the arguments \fIbytes\fR and \fInumBytes\fR (or a \fBNUL\fR-terminated string value when \fInumBytes\fR is | | | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | multiple-precision integer library, included with Tcl. .PP The routines \fBTcl_GetNumber\fR and \fBTcl_GetNumberFromObj\fR perform the same function. They differ only in how the arguments present the Tcl value to be examined. \fBTcl_GetNumber\fR accepts a counted string value in the arguments \fIbytes\fR and \fInumBytes\fR (or a \fBNUL\fR-terminated string value when \fInumBytes\fR is negative). \fBTcl_GetNumberFromObj\fR accepts the Tcl value in \fIobjPtr\fR. .PP Both routines examine the Tcl value and determine whether Tcl recognizes it as a number. If not, both routines return \fBTCL_ERROR\fR and (when \fIinterp\fR is not NULL) record an error message and error code in \fIinterp\fR. .PP |
︙ | ︙ |
Changes to doc/Object.3.
︙ | ︙ | |||
107 108 109 110 111 112 113 | .SH "THE TCL_OBJ STRUCTURE" .PP Each Tcl value is represented by a \fBTcl_Obj\fR structure which is defined as follows. .PP .CS typedef struct Tcl_Obj { | | | | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | .SH "THE TCL_OBJ STRUCTURE" .PP Each Tcl value is represented by a \fBTcl_Obj\fR structure which is defined as follows. .PP .CS typedef struct Tcl_Obj { Tcl_Size \fIrefCount\fR; char *\fIbytes\fR; Tcl_Size \fIlength\fR; const Tcl_ObjType *\fItypePtr\fR; union { long \fIlongValue\fR; double \fIdoubleValue\fR; void *\fIotherValuePtr\fR; Tcl_WideInt \fIwideValue\fR; struct { |
︙ | ︙ |
Changes to doc/OpenFileChnl.3.
︙ | ︙ | |||
49 50 51 52 53 54 55 | .sp int \fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR) .sp int \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR) .sp | | | | | | | | | | 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | .sp int \fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR) .sp int \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR) .sp Tcl_Size \fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR) .sp Tcl_Size \fBTcl_Gets\fR(\fIchannel, lineRead\fR) .sp Tcl_Size \fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR) .sp Tcl_Size \fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR) .sp Tcl_Size \fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR) .sp Tcl_Size \fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp Tcl_Size \fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR) .sp Tcl_Size \fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR) .sp int \fBTcl_Eof\fR(\fIchannel\fR) .sp int \fBTcl_Flush\fR(\fIchannel\fR) |
︙ | ︙ | |||
115 116 117 118 119 120 121 | The name of a local or network file. .AP "const char" *mode in Specifies how the file is to be accessed. May have any of the values allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. | | | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | The name of a local or network file. .AP "const char" *mode in Specifies how the file is to be accessed. May have any of the values allowed for the \fImode\fR argument to the Tcl \fBopen\fR command. .AP int permissions in POSIX-style permission flags such as 0644. If a new file is created, these permissions will be set on the created file. .AP Tcl_Size argc in The number of elements in \fIargv\fR. .AP "const char" **argv in Arguments for constructing a command pipeline. These values have the same meaning as the non-switch arguments to the Tcl \fBexec\fR command. .AP int flags in Specifies the disposition of the stdio handles in pipeline: OR-ed combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR, and |
︙ | ︙ | |||
150 151 152 153 154 155 156 | The pattern to match on, passed to Tcl_StringMatch, or NULL. .AP Tcl_Channel channel in A Tcl channel for input or output. Must have been the return value from a procedure such as \fBTcl_OpenFileChannel\fR. .AP Tcl_Obj *readObjPtr in/out A pointer to a Tcl value in which to store the characters read from the channel. | | | | | | 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | The pattern to match on, passed to Tcl_StringMatch, or NULL. .AP Tcl_Channel channel in A Tcl channel for input or output. Must have been the return value from a procedure such as \fBTcl_OpenFileChannel\fR. .AP Tcl_Obj *readObjPtr in/out A pointer to a Tcl value in which to store the characters read from the channel. .AP Tcl_Size charsToRead in The number of characters to read from the channel. If the channel's encoding is \fBbinary\fR, this is equivalent to the number of bytes to read from the channel. .AP int appendFlag in If non-zero, data read from the channel will be appended to the value. Otherwise, the data will replace the existing contents of the value. .AP char *readBuf out A buffer in which to store the bytes read from the channel. .AP Tcl_Size bytesToRead in The number of bytes to read from the channel. The buffer \fIreadBuf\fR must be large enough to hold this many bytes. .AP Tcl_Obj *lineObjPtr in/out A pointer to a Tcl value in which to store the line read from the channel. The line read will be appended to the current value of the value. .AP Tcl_DString *lineRead in/out A pointer to a Tcl dynamic string in which to store the line read from the channel. Must have been initialized by the caller. The line read will be appended to any data already in the dynamic string. .AP "const char" *input in The input to add to a channel buffer. .AP Tcl_Size inputLen in Length of the input .AP int addAtEnd in Flag indicating whether the input should be added to the end or beginning of the channel buffer. .AP Tcl_Obj *writeObjPtr in A pointer to a Tcl value whose contents will be output to the channel. .AP "const char" *charBuf in A buffer containing the characters to output to the channel. .AP "const char" *byteBuf in A buffer containing the bytes to output to the channel. .AP Tcl_Size bytesToWrite in The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and output to the channel. .AP "long long" offset in How far to move the access point in the channel at which the next input or output operation will be applied, measured in bytes from the position given by \fIseekMode\fR. May be either positive or negative. .AP int seekMode in |
︙ | ︙ | |||
402 403 404 405 406 407 408 | .SH "TCL_READCHARS AND TCL_READ" .PP \fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the | | | | 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 | .SH "TCL_READCHARS AND TCL_READ" .PP \fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes to UTF-8 based on the channel's encoding and storing the produced data in \fIreadObjPtr\fR's string representation. The return value of \fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR, that were stored in \fIreadObjPtr\fR. If an error occurs while reading, the return value is -1 and \fBTcl_ReadChars\fR records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. .PP Setting \fIcharsToRead\fR to -1 will cause the command to read all characters currently available (non-blocking) or everything until eof (blocking mode). .PP The return value may be smaller than the value to read, indicating that less data than requested was available. This is called a \fIshort read\fR. In blocking mode, this can only happen on an end-of-file. In nonblocking mode, a short read can also occur if there is not enough input currently |
︙ | ︙ | |||
467 468 469 470 471 472 473 | channel is treated as an individual Unicode character. All of the characters of the line except for the terminating end-of-line character(s) are appended to \fIlineObjPtr\fR's string representation. The end-of-line character(s) are read and discarded. .PP If a line was successfully read, the return value is greater than or equal to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an | | | | | | | | 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 | channel is treated as an individual Unicode character. All of the characters of the line except for the terminating end-of-line character(s) are appended to \fIlineObjPtr\fR's string representation. The end-of-line character(s) are read and discarded. .PP If a line was successfully read, the return value is greater than or equal to zero and indicates the number of bytes stored in \fIlineObjPtr\fR. If an error occurs, \fBTcl_GetsObj\fR returns -1 and records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR. \fBTcl_GetsObj\fR also returns -1 if the end of the file is reached; the \fBTcl_Eof\fR procedure can be used to distinguish an error from an end-of-file condition. .PP If the channel is in nonblocking mode, the return value can also be -1 if no data was available or the data that was available did not contain an end-of-line character. When -1 is returned, the \fBTcl_InputBlocked\fR procedure may be invoked to determine if the channel is blocked because of input unavailability. .PP \fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting characters are appended to the dynamic string given by \fIlineRead\fR rather than a Tcl value. .SH "TCL_UNGETS" .PP \fBTcl_Ungets\fR is used to add data to the input queue of a channel, at either the head or tail of the queue. The pointer \fIinput\fR points to the data that is to be added. The length of the input to add is given by \fIinputLen\fR. A non-zero value of \fIaddAtEnd\fR indicates that the data is to be added at the end of queue; otherwise it will be added at the head of the queue. If \fIchannel\fR has a .QW sticky EOF set, no data will be added to the input queue. \fBTcl_Ungets\fR returns \fIinputLen\fR or -1 if an error occurs. .SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE" .PP \fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at \fIcharBuf\fR. The UTF-8 characters in the buffer are converted to the channel's encoding and queued for output to \fIchannel\fR. If \fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR to be null-terminated and it outputs everything up to the null. .PP Data queued for output may not appear on the output device immediately, due to internal buffering. If the data should appear immediately, call \fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the \fB\-buffering\fR option on the channel to \fBnone\fR. If you wish the data to appear as soon as a complete line is accepted for output, set the \fB\-buffering\fR option on the channel to \fBline\fR mode. .PP The return value of \fBTcl_WriteChars\fR is a count of how many bytes were accepted for output to the channel. This is either -1 to indicate that an error occurred or another number greater than zero to indicate success. If an error occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be retrieved with \fBTcl_GetErrno\fR. .PP Newline characters in the output data are translated to platform-specific end-of-line sequences according to the \fB\-translation\fR option for the channel. This is done even if the channel has no encoding. |
︙ | ︙ |
Changes to doc/ParseArgs.3.
︙ | ︙ | |||
17 18 19 20 21 22 23 | \fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR) .SH ARGUMENTS .AS "const Tcl_ArgvInfo" ***remObjv in/out .AP Tcl_Interp *interp out Where to store error messages. .AP "const Tcl_ArgvInfo" *argTable in Pointer to array of option descriptors. | | | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | \fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR) .SH ARGUMENTS .AS "const Tcl_ArgvInfo" ***remObjv in/out .AP Tcl_Interp *interp out Where to store error messages. .AP "const Tcl_ArgvInfo" *argTable in Pointer to array of option descriptors. .AP "Tcl_Size \&| int" *objcPtr in/out A pointer to variable holding number of arguments in \fIobjv\fR. Will be modified to hold number of arguments left in the unprocessed argument list stored in \fIremObjv\fR. .AP "Tcl_Obj *const" *objv in The array of arguments to be parsed. .AP Tcl_Obj ***remObjv out Pointer to a variable that will hold the array of unprocessed arguments. |
︙ | ︙ |
Changes to doc/ParseCmd.3.
︙ | ︙ | |||
41 42 43 44 45 46 47 | For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. | | | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | For procedures other than \fBTcl_FreeParse\fR and \fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP Tcl_Size numBytes in Number of bytes in string to parse, not including any terminating null character. If less than 0 then the script consists of all characters following \fIstart\fR up to the first null character. .AP int nested in Non-zero means that the script is part of a command substitution so an unquoted close bracket should be treated as a command terminator. If zero, close brackets have no special meaning. |
︙ | ︙ | |||
192 193 194 195 196 197 198 | \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR return parse information in two data structures, Tcl_Parse and Tcl_Token: .PP .CS typedef struct Tcl_Parse { const char *\fIcommentStart\fR; | | | | | | | | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR return parse information in two data structures, Tcl_Parse and Tcl_Token: .PP .CS typedef struct Tcl_Parse { const char *\fIcommentStart\fR; Tcl_Size \fIcommentSize\fR; const char *\fIcommandStart\fR; Tcl_Size \fIcommandSize\fR; Tcl_Size \fInumWords\fR; Tcl_Token *\fItokenPtr\fR; Tcl_Size \fInumTokens\fR; ... } \fBTcl_Parse\fR; typedef struct Tcl_Token { int \fItype\fR; const char *\fIstart\fR; Tcl_Size \fIsize\fR; Tcl_Size \fInumComponents\fR; } \fBTcl_Token\fR; .CE .PP The first five fields of a Tcl_Parse structure are filled in only by \fBTcl_ParseCommand\fR. These fields are not used by the other parsing procedures. .PP |
︙ | ︙ |
Changes to doc/PkgRequire.3.
︙ | ︙ | |||
51 52 53 54 55 56 57 | .AP "const void" *clientData in Arbitrary value to be associated with the package. .AP void *clientDataPtr out Pointer to place to store the value associated with the matching package. It is only changed if the pointer is not NULL and the function completed successfully. The storage can be any pointer type with the same size as a void pointer. | | | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | .AP "const void" *clientData in Arbitrary value to be associated with the package. .AP void *clientDataPtr out Pointer to place to store the value associated with the matching package. It is only changed if the pointer is not NULL and the function completed successfully. The storage can be any pointer type with the same size as a void pointer. .AP Tcl_Size objc in Number of requirements. .AP Tcl_Obj* objv[] in Array of requirements. .BE .SH DESCRIPTION .PP These procedures provide C-level interfaces to Tcl's package and |
︙ | ︙ |
Changes to doc/RegExp.3.
︙ | ︙ | |||
60 61 62 63 64 65 66 | by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP "const char" *start in If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. | | | | | | 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR. .AP "const char" *start in If \fItext\fR is just a portion of some other string, this argument identifies the beginning of the larger string. If it is not the same as \fItext\fR, then no .QW \fB^\fR matches will be allowed. .AP Tcl_Size index in Specifies which range is desired: 0 means the range of the entire match, 1 or greater means the range that matched a parenthesized sub-expression. .AP "const char" **startPtr out The address of the first character in the range is stored here, or NULL if there is no such range. .AP "const char" **endPtr out The address of the character just after the last one in the range is stored here, or NULL if there is no such range. .AP int cflags in OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR, \fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR, \fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR, \fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and \fBTCL_REG_CANMATCH\fR. See below for more information. .AP Tcl_Size offset in The character offset into the text where matching should begin. The value of the offset has no impact on \fB^\fR matches. This behavior is controlled by \fIeflags\fR. .AP Tcl_Size nmatches in The number of matching subexpressions that should be remembered for later use. If this value is 0, then no subexpression match information will be computed. If the value is negative, then all of the matching subexpressions will be remembered. Any other value will be taken as the maximum number of subexpressions to remember. .AP int eflags in OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and \fBTCL_REG_NOTEOL\fR. See below for more information. .AP Tcl_RegExpInfo *infoPtr out |
︙ | ︙ | |||
333 334 335 336 337 338 339 | \fBTcl_RegExpGetInfo\fR retrieves information about the last match performed with a given regular expression \fIregexp\fR. The \fIinfoPtr\fR argument contains a pointer to a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { | | | | | | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 | \fBTcl_RegExpGetInfo\fR retrieves information about the last match performed with a given regular expression \fIregexp\fR. The \fIinfoPtr\fR argument contains a pointer to a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpInfo { Tcl_Size \fInsubs\fR; Tcl_RegExpIndices *\fImatches\fR; Tcl_Size \fIextendStart\fR; } \fBTcl_RegExpInfo\fR; .CE .PP The \fInsubs\fR field contains a count of the number of parenthesized subexpressions within the regular expression. If the \fBTCL_REG_NOSUB\fR was used, then this value will be zero. The \fImatches\fR field points to an array of \fInsubs\fR+1 values that indicate the bounds of each subexpression matched. The first element in the array refers to the range matched by the entire regular expression, and subsequent elements refer to the parenthesized subexpressions in the order that they appear in the pattern. Each element is a structure that is defined as follows: .PP .CS typedef struct Tcl_RegExpIndices { Tcl_Size \fIstart\fR; Tcl_Size \fIend\fR; } \fBTcl_RegExpIndices\fR; .CE .PP The \fIstart\fR and \fIend\fR values are Unicode character indices relative to the offset location within \fIobjPtr\fR where matching began. The \fIstart\fR index identifies the first character of the matched subexpression. The \fIend\fR index identifies the first character |
︙ | ︙ |
Changes to doc/SetRecLmt.3.
︙ | ︙ | |||
10 11 12 13 14 15 16 | .BS .SH NAME Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp | | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | .BS .SH NAME Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Size \fBTcl_SetRecursionLimit\fR(\fIinterp, depth\fR) .SH ARGUMENTS .AS Tcl_Interp *interp .AP Tcl_Interp *interp in Interpreter whose recursion limit is to be set. Must be greater than zero. .AP Tcl_Size depth in New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR. .BE .SH DESCRIPTION .PP At any given time Tcl enforces a limit on the number of recursive calls that may be active for \fBTcl_Eval\fR and related procedures |
︙ | ︙ |
Changes to doc/SplitList.3.
︙ | ︙ | |||
16 17 18 19 20 21 22 | .sp int \fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR) .sp char * \fBTcl_Merge\fR(\fIargc, argv\fR) .sp | | | | | | | | | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | .sp int \fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR) .sp char * \fBTcl_Merge\fR(\fIargc, argv\fR) .sp Tcl_Size \fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR) .sp Tcl_Size \fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR) .sp Tcl_Size \fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR) .sp Tcl_Size \fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr out .AP Tcl_Interp *interp out Interpreter to use for error reporting. If NULL, then no error message is left. .AP "const char" *list in Pointer to a string with proper list structure. .AP "Tcl_Size \&| int" *argcPtr out Filled in with number of elements in \fIlist\fR. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of pointers to the strings that are the extracted elements of \fIlist\fR. There will be \fI*argcPtr\fR valid entries in the array, followed by a NULL entry. .AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP "const char *const" *argv in Array of strings to merge together into a single list. Each string will become a separate element of the list. .AP "const char" *src in String that is to become an element of a list. .AP int *flagsPtr in Pointer to word to fill in with information about \fIsrc\fR. The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR. .AP Tcl_Size length in Number of bytes in string \fIsrc\fR. .AP char *dst in Place to copy converted list element. Must contain enough characters to hold converted string. .AP int flags in Information about \fIsrc\fR. Must be value returned by previous call to \fBTcl_ScanElement\fR, possibly OR-ed |
︙ | ︙ | |||
77 78 79 80 81 82 83 | addition to the array of pointers, it also holds copies of all the list elements. It is the caller's responsibility to free up all of this storage. For example, suppose that you have called \fBTcl_SplitList\fR with the following code: .PP .CS | | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | addition to the array of pointers, it also holds copies of all the list elements. It is the caller's responsibility to free up all of this storage. For example, suppose that you have called \fBTcl_SplitList\fR with the following code: .PP .CS Tcl_Size argc; int code; char *string; char **argv; \&... code = \fBTcl_SplitList\fR(interp, string, &argc, &argv); .CE .PP |
︙ | ︙ |
Changes to doc/SplitPath.3.
︙ | ︙ | |||
21 22 23 24 25 26 27 | Tcl_PathType \fBTcl_GetPathType\fR(\fIpath\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr in/out .AP "const char" *path in File path in a form appropriate for the current platform (see the \fBfilename\fR manual entry for acceptable forms for path names). | | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 | Tcl_PathType \fBTcl_GetPathType\fR(\fIpath\fR) .SH ARGUMENTS .AS "const char *const" ***argvPtr in/out .AP "const char" *path in File path in a form appropriate for the current platform (see the \fBfilename\fR manual entry for acceptable forms for path names). .AP "Tcl_Size \&| int" *argcPtr out Filled in with number of path elements in \fIpath\fR. .AP "const char" ***argvPtr out \fI*argvPtr\fR will be filled in with the address of an array of pointers to the strings that are the extracted elements of \fIpath\fR. There will be \fI*argcPtr\fR valid entries in the array, followed by a NULL entry. .AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP "const char *const" *argv in Array of path elements to merge together into a single path. .AP Tcl_DString *resultPtr in/out A pointer to an initialized \fBTcl_DString\fR to which the result of \fBTcl_JoinPath\fR will be appended. .BE |
︙ | ︙ | |||
57 58 59 60 61 62 63 | dynamically allocated; in addition to the array of pointers, it also holds copies of all the path elements. It is the caller's responsibility to free all of this storage. For example, suppose that you have called \fBTcl_SplitPath\fR with the following code: .PP .CS | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | dynamically allocated; in addition to the array of pointers, it also holds copies of all the path elements. It is the caller's responsibility to free all of this storage. For example, suppose that you have called \fBTcl_SplitPath\fR with the following code: .PP .CS Tcl_Size argc; char *path; char **argv; \&... Tcl_SplitPath(string, &argc, &argv); .CE .PP Then you should eventually free the storage with a call like the |
︙ | ︙ |
Changes to doc/StringObj.3.
︙ | ︙ | |||
36 37 38 39 40 41 42 | .sp Tcl_UniChar * \fBTcl_GetUnicode\fR(\fIobjPtr\fR) .sp int \fBTcl_GetUniChar\fR(\fIobjPtr, index\fR) .sp | | | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | .sp Tcl_UniChar * \fBTcl_GetUnicode\fR(\fIobjPtr\fR) .sp int \fBTcl_GetUniChar\fR(\fIobjPtr, index\fR) .sp Tcl_Size \fBTcl_GetCharLength\fR(\fIobjPtr\fR) .sp Tcl_Obj * \fBTcl_GetRange\fR(\fIobjPtr, first, last\fR) .sp void \fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR) |
︙ | ︙ | |||
83 84 85 86 87 88 89 | \fBTcl_ConcatObj\fR(\fIobjc, objv\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters | | | | | | | | | | | | | | | | | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 | \fBTcl_ConcatObj\fR(\fIobjc, objv\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *appendObjPtr in/out .AP "const char" *bytes in Points to the first byte of an array of UTF-8-encoded bytes used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. (Applications needing null bytes should represent them as the two-byte sequence \fI\e300\e200\fR, use \fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if the string is a collection of uninterpreted bytes.) .AP Tcl_Size length in The number of bytes to copy from \fIbytes\fR when initializing, setting, or appending to a string value. If negative, all bytes up to the first null are used. .AP "const Tcl_UniChar" *unicode in Points to the first byte of an array of Unicode characters used to set or append to a string value. This byte array may contain embedded null characters unless \fInumChars\fR is negative. .AP Tcl_Size numChars in The number of Unicode characters to copy from \fIunicode\fR when initializing, setting, or appending to a string value. If negative, all characters up to the first null character are used. .AP Tcl_Size index in The index of the Unicode character to return. .AP Tcl_Size first in The index of the first Unicode character in the Unicode range to be returned as a new value. If negative, behave the same as if the value was 0. .AP Tcl_Size last in The index of the last Unicode character in the Unicode range to be returned as a new value. If negative, take all characters up to the last one available. .AP Tcl_Obj *objPtr in/out Points to a value to manipulate. .AP Tcl_Obj *appendObjPtr in The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR. .AP "ptrdiff_t \&| int" *lengthPtr out The location where \fBTcl_GetStringFromObj\fR will store the length of a value's string representation. May be (int *)NULL when not used. .AP "const char" *string in Null-terminated string value to append to \fIobjPtr\fR. .AP va_list argList in An argument list which must have been initialized using \fBva_start\fR, and cleared using \fBva_end\fR. .AP Tcl_Size limit in Maximum number of bytes to be appended. .AP "const char" *ellipsis in Suffix to append when the limit leads to string truncation. If NULL is passed then the suffix .QW "..." is used. .AP "const char" *format in Format control string including % conversion specifiers. .AP Tcl_Size objc in The number of elements to format or concatenate. .AP Tcl_Obj *objv[] in The array of values to format or concatenate. .AP Tcl_Size newLength in New length for the string value of \fIobjPtr\fR, not including the final null character. .BE .SH DESCRIPTION .PP The procedures described in this manual entry allow Tcl values to be manipulated as string values. They use the internal representation |
︙ | ︙ | |||
209 210 211 212 213 214 215 | value's Unicode representation. If the index is out of range or it references a low surrogate preceded by a high surrogate, it returns -1; .PP \fBTcl_GetRange\fR returns a newly created value comprised of the characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's Unicode representation. If the value's Unicode representation is invalid, the Unicode representation is regenerated from the value's | | | | 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 | value's Unicode representation. If the index is out of range or it references a low surrogate preceded by a high surrogate, it returns -1; .PP \fBTcl_GetRange\fR returns a newly created value comprised of the characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's Unicode representation. If the value's Unicode representation is invalid, the Unicode representation is regenerated from the value's string representation. If \fIfirst\fR is negative, then the returned string starts at the beginning of the value. If \fIlast\fR negative, then the returned string ends at the end of the value. .PP \fBTcl_GetCharLength\fR returns the number of characters (as opposed to bytes) in the string value. .PP \fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and \fIlength\fR to the string representation of the value specified by |
︙ | ︙ | |||
259 260 261 262 263 264 265 | end result should be kept short enough to be read. Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more than \fIlimit\fR bytes total are to be appended. If the limit prevents all \fIlength\fR bytes that are available from being appended, then the appending is done so that the last bytes appended are from the string \fIellipsis\fR. This allows for an indication of the truncation to be left in the string. | | | 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 | end result should be kept short enough to be read. Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more than \fIlimit\fR bytes total are to be appended. If the limit prevents all \fIlength\fR bytes that are available from being appended, then the appending is done so that the last bytes appended are from the string \fIellipsis\fR. This allows for an indication of the truncation to be left in the string. When \fIlength\fR is negative, all bytes up to the first zero byte are appended, subject to the limit. When \fIellipsis\fR is NULL, the default string \fB...\fR is used. When \fIellipsis\fR is non-NULL, it must point to a zero-byte-terminated string in Tcl's internal UTF encoding. The number of bytes appended can be less than the lesser of \fIlength\fR and \fIlimit\fR when appending fewer bytes is necessary to append only whole multi-byte characters. .PP |
︙ | ︙ | |||
302 303 304 305 306 307 308 | functionality is needed. .PP \fBTcl_ObjPrintf\fR serves as a replacement for the common sequence .PP .CS char buf[SOME_SUITABLE_LENGTH]; sprintf(buf, format, ...); | | | 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 | functionality is needed. .PP \fBTcl_ObjPrintf\fR serves as a replacement for the common sequence .PP .CS char buf[SOME_SUITABLE_LENGTH]; sprintf(buf, format, ...); \fBTcl_NewStringObj\fR(buf, -1); .CE .PP but with greater convenience and no need to determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same core formatting engine used by \fBTcl_Format\fR. This means the set of supported conversion specifiers is that of the \fBformat\fR command and not that of the \fBsprintf\fR routine where the two sets differ. When a |
︙ | ︙ |
Changes to doc/TclZlib.3.
︙ | ︙ | |||
84 85 86 87 88 89 90 | section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this dictionary. .AP "unsigned int" initValue in The initial value for the checksum algorithm. .AP "unsigned char" *bytes in An array of bytes to run the checksum algorithm over, or NULL to get the recommended initial value for the checksum algorithm. | | | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this dictionary. .AP "unsigned int" initValue in The initial value for the checksum algorithm. .AP "unsigned char" *bytes in An array of bytes to run the checksum algorithm over, or NULL to get the recommended initial value for the checksum algorithm. .AP Tcl_Size length in The number of bytes in the array. .AP int mode in What mode to operate the stream in. Should be either \fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or \fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream. .AP Tcl_ZlibStream *zshandlePtr out A pointer to a variable in which to write the abstract token for the stream upon successful creation. .AP Tcl_ZlibStream zshandle in The abstract token for the stream to operate on. .AP int flush in Whether and how to flush the stream after writing the data to it. Must be one of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR if the currently compressed data must be made available for access using \fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put into a state where the decompressor can recover from on corruption, or \fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any trailer demanded by the format is written. .AP Tcl_Size count in The maximum number of bytes to get from the stream, or -1 to get all remaining bytes from the stream's buffers. .AP Tcl_Obj *compDict in A byte array value that is the compression dictionary to use with the stream. Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this only ever be used with streams that were created with their \fIformat\fR set to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to indicate whether a compression dictionary was present other than to fail on |
︙ | ︙ |
Changes to doc/Tcl_Main.3.
︙ | ︙ | |||
25 26 27 28 29 30 31 | .sp Tcl_Obj * \fBTcl_GetStartupScript\fR(\fIencodingPtr\fR) .sp \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc | | | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | .sp Tcl_Obj * \fBTcl_GetStartupScript\fR(\fIencodingPtr\fR) .sp \fBTcl_SetMainLoop\fR(\fImainLoopProc\fR) .SH ARGUMENTS .AS Tcl_MainLoopProc *mainLoopProc .AP Tcl_Size argc in Number of elements in \fIargv\fR. .AP char *argv[] in Array of strings containing command-line arguments. On Windows, when using -DUNICODE, the parameter type changes to wchar_t *. .AP char *charargv[] in As argv, but does not change type to wchar_t. .AP char *wideargv[] in |
︙ | ︙ |
Changes to doc/ToUpper.3.
︙ | ︙ | |||
18 19 20 21 22 23 24 | .sp int \fBTcl_UniCharToLower\fR(\fIch\fR) .sp int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp | | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | .sp int \fBTcl_UniCharToLower\fR(\fIch\fR) .sp int \fBTcl_UniCharToTitle\fR(\fIch\fR) .sp Tcl_Size \fBTcl_UtfToUpper\fR(\fIstr\fR) .sp Tcl_Size \fBTcl_UtfToLower\fR(\fIstr\fR) .sp Tcl_Size \fBTcl_UtfToTitle\fR(\fIstr\fR) .SH ARGUMENTS .AS char *str in/out .AP int ch in The Unicode character to be converted. .AP char *str in/out Pointer to UTF-8 string to be converted in place. |
︙ | ︙ |
Changes to doc/Utf.3.
︙ | ︙ | |||
11 12 13 14 15 16 17 | Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp | | | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp typedef ... \fBTcl_UniChar\fR; .sp Tcl_Size \fBTcl_UniCharToUtf\fR(\fIch, buf\fR) .sp Tcl_Size \fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR) .sp Tcl_Size \fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR) .sp Tcl_Size \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR) .sp char * \fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR) .sp char * \fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR) |
︙ | ︙ | |||
89 90 91 92 93 94 95 | .sp int \fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR) .sp const char * \fBTcl_UtfAtIndex\fR(\fIsrc, index\fR) .sp | | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | .sp int \fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR) .sp const char * \fBTcl_UtfAtIndex\fR(\fIsrc, index\fR) .sp Tcl_Size \fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR) .SH ARGUMENTS .AS "const Tcl_UniChar" *uniPattern in/out .AP char *buf out Buffer in which the UTF-8 representation of the Tcl_UniChar is stored. At most 4 bytes are stored in the buffer. .AP int ch in |
︙ | ︙ | |||
128 129 130 131 132 133 134 | A null-terminated wchar_t string. .AP "const unsigned short" *utf16s in A null-terminated utf-16 string. .AP "const unsigned short" *utf16t in A null-terminated utf-16 string. .AP "const unsigned short" *utf16Pattern in A null-terminated utf-16 string. | | | | | | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | A null-terminated wchar_t string. .AP "const unsigned short" *utf16s in A null-terminated utf-16 string. .AP "const unsigned short" *utf16t in A null-terminated utf-16 string. .AP "const unsigned short" *utf16Pattern in A null-terminated utf-16 string. .AP Tcl_Size length in The length of the UTF-8 string in bytes (not UTF-8 characters). If negative, all bytes up to the first null byte are used. .AP Tcl_Size uniLength in The length of the Unicode string in characters. .AP "Tcl_DString" *dsPtr in/out A pointer to a previously initialized \fBTcl_DString\fR. .AP "const char" *start in Pointer to the beginning of a UTF-8 string. .AP Tcl_Size index in The index of a character (not byte) in the UTF-8 string. .AP int *readPtr out If non-NULL, filled with the number of bytes in the backslash sequence, including the backslash character. .AP char *dst out Buffer in which the bytes represented by the backslash sequence are stored. At most 4 bytes are stored in the buffer. |
︙ | ︙ | |||
250 251 252 253 254 255 256 | does not guarantee that the UTF-8 string is properly formed. This routine is used by procedures that are operating on a byte at a time and need to know if a full Unicode character has been seen. .PP \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string \fIsrc\fR. The length of the source string is \fIlength\fR bytes. If the | | | 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | does not guarantee that the UTF-8 string is properly formed. This routine is used by procedures that are operating on a byte at a time and need to know if a full Unicode character has been seen. .PP \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It returns the number of Tcl_UniChars that are represented by the UTF-8 string \fIsrc\fR. The length of the source string is \fIlength\fR bytes. If the length is negative, all bytes up to the first null byte are used. .PP \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings. It returns a pointer to the first occurrence of the Unicode character \fIch\fR in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is considered part of the UTF-8 string. .PP \fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings. It |
︙ | ︙ | |||
295 296 297 298 299 300 301 | byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte \fIsrc[-5]\fR. .PP \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the Pascal Ord() function. It returns the Unicode character represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR | | | | 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 | byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte \fIsrc[-5]\fR. .PP \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the Pascal Ord() function. It returns the Unicode character represented at the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. If \fIindex\fR is negative or \fIindex\fR points to the second half of a surrogate pair, it returns -1. .PP \fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not byte) \fIindex\fR in the UTF-8 string \fIsrc\fR. The source string must contain at least \fIindex\fR characters. This is equivalent to calling \fBTcl_UtfToUniChar\fR \fIindex\fR times. If \fIindex\fR is negative, the return pointer points to the first character in the source string. .PP \fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl commands. It parses a backslash sequence and stores the properly formed UTF-8 character represented by the backslash sequence in the output buffer \fIdst\fR. At most 4 bytes are stored in the buffer. \fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number |
︙ | ︙ |
Changes to doc/WrongNumArgs.3.
︙ | ︙ | |||
15 16 17 18 19 20 21 | .sp \fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR) .SH ARGUMENTS .AS "Tcl_Obj *const" *message .AP Tcl_Interp interp in Interpreter in which error will be reported: error message gets stored in its result value. | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | .sp \fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR) .SH ARGUMENTS .AS "Tcl_Obj *const" *message .AP Tcl_Interp interp in Interpreter in which error will be reported: error message gets stored in its result value. .AP Tcl_Size objc in Number of leading arguments from \fIobjv\fR to include in error message. .AP "Tcl_Obj *const" objv[] in Arguments to command that had the wrong number of arguments. .AP "const char" *message in Additional error information to print after leading arguments from \fIobjv\fR. This typically gives the acceptable syntax |
︙ | ︙ |
Changes to generic/tcl.decls.
︙ | ︙ | |||
2468 2469 2470 2471 2472 2473 2474 | # TIP #568 declare 649 { unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr) } declare 650 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, | | | | | | 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 | # TIP #568 declare 649 { unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr) } declare 650 { unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr) } # TIP #481 declare 651 { char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } declare 652 { Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr) } # Only available in Tcl 8.x, NULL in Tcl 9.0 declare 653 { unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, Tcl_Size *numBytesPtr) } # TIP #575 declare 654 { int Tcl_UtfCharComplete(const char *src, Tcl_Size length) } declare 655 { |
︙ | ︙ | |||
2517 2518 2519 2520 2521 2522 2523 | declare 660 { int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber) } # TIP #616 declare 661 { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, | | | | | | | | | 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 | declare 660 { int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber) } # TIP #616 declare 661 { int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) } declare 662 { int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr) } declare 663 { int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr) } declare 664 { int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr) } declare 665 { void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr) } declare 666 { Tcl_Obj *Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr) } declare 667 { int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) } # TIP #617 declare 668 { Tcl_Size Tcl_UniCharLen(const int *uniStr) } declare 669 { |
︙ | ︙ | |||
2588 2589 2590 2591 2592 2593 2594 | Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 679 { int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, | | | | 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 | Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc) } declare 679 { int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]) } # TIP #638. declare 680 { int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr) } declare 681 { int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr) } # TIP #220. declare 682 { int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) } |
︙ | ︙ | |||
2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 | Tcl_WideUInt *uwidePtr) } # TIP 651 declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { void TclUnusedStubEntry(void) } | > > > > > > | 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 | Tcl_WideUInt *uwidePtr) } # TIP 651 declare 685 { Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr) } # TIP 660 declare 686 { int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr) } # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 688 { void TclUnusedStubEntry(void) } |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
322 323 324 325 326 327 328 | #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if TCL_MAJOR_VERSION < 9 typedef int Tcl_Size; # define TCL_SIZE_MODIFIER "" # define TCL_SIZE_MAX INT_MAX #else | | | 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 | #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if TCL_MAJOR_VERSION < 9 typedef int Tcl_Size; # define TCL_SIZE_MODIFIER "" # define TCL_SIZE_MAX INT_MAX #else typedef ptrdiff_t Tcl_Size; # define TCL_SIZE_MAX PTRDIFF_MAX # define TCL_SIZE_MODIFIER TCL_T_MODIFIER #endif /* TCL_MAJOR_VERSION */ #ifdef _WIN32 # if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; |
︙ | ︙ | |||
557 558 559 560 561 562 563 | typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, | | | 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 | typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, ptrdiff_t level, const char *command, Tcl_Command commandInfo, ptrdiff_t objc, struct Tcl_Obj *const *objv); typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); |
︙ | ︙ | |||
582 583 584 585 586 587 588 | typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, | | | 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 | typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, ptrdiff_t objc, struct Tcl_Obj *const *objv); typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); |
︙ | ︙ | |||
2322 2323 2324 2325 2326 2327 2328 | EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif #if defined(_WIN32) && defined(UNICODE) #ifndef USE_TCL_STUBS # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) #endif # define Tcl_MainEx Tcl_MainExW | | | | 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 | EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif #if defined(_WIN32) && defined(UNICODE) #ifndef USE_TCL_STUBS # define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg))) #endif # define Tcl_MainEx Tcl_MainExW EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif #if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8) #define Tcl_SetPanicProc(panicProc) \ TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc)) #define Tcl_InitSubsystems() \ TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))()) #define Tcl_FindExecutable(argv0) \ TclInitStubTable(((const char *(*)(const char *))TclStubCall((void *)2))(argv0)) #define TclZipfs_AppHook(argcp, argvp) \ TclInitStubTable(((const char *(*)(int *, void *))TclStubCall((void *)3))(argcp, argvp)) #define Tcl_MainExW(argc, argv, appInitProc, interp) \ (void)((const char *(*)(Tcl_Size, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)4))(argc, argv, appInitProc, interp) #if !defined(_WIN32) || !defined(UNICODE) #define Tcl_MainEx(argc, argv, appInitProc, interp) \ (void)((const char *(*)(size_t, const void *, Tcl_AppInitProc *, Tcl_Interp *)) \ TclStubCall((void *)5))(argc, argv, appInitProc, interp) #endif #define Tcl_StaticLibrary(interp, pkgName, initProc, safeInitProc) \ |
︙ | ︙ |
Changes to generic/tclArithSeries.c.
︙ | ︙ | |||
353 354 355 356 357 358 359 | dend = end; } } if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { Tcl_SetObjResult( interp, | | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | dend = end; } } if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (arithSeriesObj) { *arithSeriesObj = (useDoubles) ? NewArithSeriesDbl(dstart, dend, dstep, len) |
︙ | ︙ | |||
440 441 442 443 444 445 446 | Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %" | | | 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 | Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj); if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %" TCL_LL_MODIFIER "d", index, (arithSeriesRepPtr->len-1))); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return NULL; } /* List[i] = Start + (Step * index) */ if (arithSeriesRepPtr->isDouble) { return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); |
︙ | ︙ | |||
861 862 863 864 865 866 867 | } else { /* Construct the elements array */ objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc); if (objv == NULL) { if (interp) { Tcl_SetObjResult( interp, | | | 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 | } else { /* Construct the elements array */ objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc); if (objv == NULL) { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } return TCL_ERROR; } arithSeriesRepPtr->elements = objv; for (i = 0; i < objc; i++) { objv[i] = TclArithSeriesObjIndex(interp, objPtr, i); |
︙ | ︙ |
Changes to generic/tclArithSeries.h.
︙ | ︙ | |||
12 13 14 15 16 17 18 | /* * The structure used for the ArithSeries internal representation. * Note that the len can in theory be always computed by start,end,step * but it's faster to cache it inside the internal representation. */ typedef struct { | | | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | /* * The structure used for the ArithSeries internal representation. * Note that the len can in theory be always computed by start,end,step * but it's faster to cache it inside the internal representation. */ typedef struct { Tcl_WideInt len; Tcl_Obj **elements; int isDouble; Tcl_WideInt start; Tcl_WideInt end; Tcl_WideInt step; } ArithSeries; typedef struct { Tcl_WideInt len; Tcl_Obj **elements; int isDouble; double start; double end; double step; } ArithSeriesDbl; |
︙ | ︙ |
Changes to generic/tclAssembly.c.
︙ | ︙ | |||
218 219 220 221 222 223 224 | typedef struct AssemblyEnv { CompileEnv* envPtr; /* Compilation environment being used for code * generation */ Tcl_Parse* parsePtr; /* Parse of the current line of source */ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ | | | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 | typedef struct AssemblyEnv { CompileEnv* envPtr; /* Compilation environment being used for code * generation */ Tcl_Parse* parsePtr; /* Parse of the current line of source */ Tcl_HashTable labelHash; /* Hash table whose keys are labels and whose * values are 'label' objects storing the code * offsets of the labels. */ Tcl_Size cmdLine; /* Current line number within the assembly * code */ int* clNext; /* Invisible continuation line for * [info frame] */ BasicBlock* head_bb; /* First basic block in the code */ BasicBlock* curr_bb; /* Current basic block */ int maxDepth; /* Maximum stack depth encountered */ int curCatchDepth; /* Current depth of catches */ |
︙ | ︙ | |||
1265 1266 1267 1268 1269 1270 1271 | Tcl_Obj* instNameObj; /* Name of the instruction */ int tblIdx; /* Index in TalInstructionTable of the * instruction */ TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ | | | | 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 | Tcl_Obj* instNameObj; /* Name of the instruction */ int tblIdx; /* Index in TalInstructionTable of the * instruction */ TalInstType instType; /* Type of the instruction */ Tcl_Obj* operand1Obj = NULL; /* First operand to the instruction */ const char* operand1; /* String rep of the operand */ Tcl_Size operand1Len; /* String length of the operand */ int opnd; /* Integer representation of an operand */ int litIndex; /* Literal pool index of a constant */ Tcl_Size localVar; /* LVT index of a local variable */ int flags; /* Flags for a basic block */ JumptableInfo* jtPtr; /* Pointer to a jumptable */ int infoIndex; /* Index of the jumptable in auxdata */ int status = TCL_ERROR; /* Return value from this function */ /* * Make sure that the instruction name is known at compile time. |
︙ | ︙ | |||
1363 1364 1365 1366 1367 1368 1369 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); | | | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName"); goto cleanup; } if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; case ASSEM_CLOCK_READ: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 0 || opnd > 3) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operand must be [0..3]", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL); goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_CONCAT1: |
︙ | ︙ | |||
1423 1424 1425 1426 1427 1428 1429 | goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); | | | | 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 | goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1); TclEmitInt4(localVar, envPtr); break; case ASSEM_DICT_UNSET: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckStrictlyPositive(interp, opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); TclEmitInt4(localVar, envPtr); break; case ASSEM_END_CATCH: |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 | } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, | | | | | | | 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 | } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } if (opnd < 2) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("operand must be >=2", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL); } goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd); break; case ASSEM_LVT: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_LVT1_SINT1: if (parsePtr->numWords != 3) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0 || CheckOneByte(interp, localVar) || GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK || CheckSignedOneByte(interp, opnd)) { goto cleanup; } BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0); TclEmitInt1(opnd, envPtr); break; case ASSEM_LVT4: if (parsePtr->numWords != 2) { Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname"); goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0); break; case ASSEM_OVER: if (parsePtr->numWords != 2) { |
︙ | ︙ | |||
1738 1739 1740 1741 1742 1743 1744 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); | | | 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 | Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName"); goto cleanup; } if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) { goto cleanup; } localVar = FindLocalVar(assemEnvPtr, &tokenPtr); if (localVar < 0) { goto cleanup; } BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0); TclEmitInt4(localVar, envPtr); break; default: |
︙ | ︙ | |||
1965 1966 1967 1968 1969 1970 1971 | */ static int CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { | | | | 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 | */ static int CreateMirrorJumpTable( AssemblyEnv* assemEnvPtr, /* Assembly environment */ Tcl_Obj* jumps) /* List of alternating keywords and labels */ { Tcl_Size objc; /* Number of elements in the 'jumps' list */ Tcl_Obj** objv; /* Pointers to the elements in the list */ CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ BasicBlock* bbPtr = assemEnvPtr->curr_bb; /* Current basic block */ JumptableInfo* jtPtr; Tcl_HashTable* jtHashPtr; /* Hashtable in the JumptableInfo */ Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */ int isNew; /* Flag==1 if the key is not yet in the * table. */ Tcl_Size i; if (TclListObjLengthM(interp, jumps, &objc) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( |
︙ | ︙ | |||
2103 2104 2105 2106 2107 2108 2109 | Tcl_Obj* operandObj; TclNewObj(operandObj); if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) { Tcl_DecrRefCount(operandObj); if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 | Tcl_Obj* operandObj; TclNewObj(operandObj); if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) { Tcl_DecrRefCount(operandObj); if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "assembly code may not contain substitutions", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL); } return TCL_ERROR; } *tokenPtrPtr = TokenAfter(*tokenPtrPtr); Tcl_IncrRefCount(operandObj); *operandObjPtr = operandObj; |
︙ | ︙ | |||
2309 2310 2311 2312 2313 2314 2315 | Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; | | | | | | 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 | Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ Tcl_Token* tokenPtr = *tokenPtrPtr; /* INOUT: Pointer to the next token in the * source code. */ Tcl_Obj* varNameObj; /* Name of the variable */ const char* varNameStr; Tcl_Size varNameLen; Tcl_Size localVar; /* Index of the variable in the LVT */ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) { return TCL_INDEX_NONE; } varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen); if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) { Tcl_DecrRefCount(varNameObj); return TCL_INDEX_NONE; } localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr); Tcl_DecrRefCount(varNameObj); if (localVar < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use this instruction to create a variable" " in a non-proc context", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL); } return TCL_INDEX_NONE; } *tokenPtrPtr = TokenAfter(tokenPtr); return localVar; } |
︙ | ︙ | |||
2396 2397 2398 2399 2400 2401 2402 | CheckOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0 || value > 0xFF) { | | | 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 | CheckOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0 || value > 0xFF) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } return TCL_OK; } |
︙ | ︙ | |||
2431 2432 2433 2434 2435 2436 2437 | CheckSignedOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value > 0x7F || value < -0x80) { | | | 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 | CheckSignedOneByte( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value > 0x7F || value < -0x80) { result = Tcl_NewStringObj("operand does not fit in one byte", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL); return TCL_ERROR; } return TCL_OK; } |
︙ | ︙ | |||
2464 2465 2466 2467 2468 2469 2470 | CheckNonNegative( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0) { | | | 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 | CheckNonNegative( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value < 0) { result = Tcl_NewStringObj("operand must be nonnegative", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL); return TCL_ERROR; } return TCL_OK; } |
︙ | ︙ | |||
2497 2498 2499 2500 2501 2502 2503 | CheckStrictlyPositive( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value <= 0) { | | | 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 | CheckStrictlyPositive( Tcl_Interp* interp, /* Tcl interpreter for error reporting */ int value) /* Value to check */ { Tcl_Obj* result; /* Error message */ if (value <= 0) { result = Tcl_NewStringObj("operand must be positive", -1); Tcl_SetObjResult(interp, result); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL); return TCL_ERROR; } return TCL_OK; } |
︙ | ︙ | |||
3317 3318 3319 3320 3321 3322 3323 | static int CheckStack( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ | | | 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 | static int CheckStack( AssemblyEnv* assemEnvPtr) /* Assembly environment */ { CompileEnv* envPtr = assemEnvPtr->envPtr; /* Compilation environment */ Tcl_Size maxDepth; /* Maximum stack depth overall */ /* * Checking the head block will check all the other blocks recursively. */ assemEnvPtr->maxDepth = 0; if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL, |
︙ | ︙ | |||
3410 3411 3412 3413 3414 3415 3416 | */ if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 | */ if (blockPtr->initialStackDepth == initialStackDepth) { return TCL_OK; } if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "inconsistent stack depths on two execution paths", -1)); /* * TODO - add execution trace of both paths */ Tcl_SetErrorLine(interp, blockPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); |
︙ | ︙ | |||
3439 3440 3441 3442 3443 3444 3445 | /* * Calculate minimum stack depth, and flag an error if the block * underflows the stack. */ if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { | | | | | 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 | /* * Calculate minimum stack depth, and flag an error if the block * underflows the stack. */ if (initialStackDepth + blockPtr->minStackDepth < 0) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; } /* * Make sure that the block doesn't try to pop below the stack level of an * enclosing catch. */ if (blockPtr->enclosingCatch != 0 && initialStackDepth + blockPtr->minStackDepth < (blockPtr->enclosingCatch->initialStackDepth + blockPtr->enclosingCatch->finalStackDepth)) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "code pops stack below level of enclosing catch", -1)); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1); AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr); Tcl_SetErrorLine(interp, blockPtr->startLine); } return TCL_ERROR; } /* |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | if (bbPtr->catchState == BBCS_UNKNOWN) { bbPtr->enclosingCatch = enclosing; } else if (bbPtr->enclosingCatch != enclosing) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "execution reaches an instruction in inconsistent " | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 | if (bbPtr->catchState == BBCS_UNKNOWN) { bbPtr->enclosingCatch = enclosing; } else if (bbPtr->enclosingCatch != enclosing) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "execution reaches an instruction in inconsistent " "exception contexts", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL); } return TCL_ERROR; } if (state > bbPtr->catchState) { bbPtr->catchState = state; |
︙ | ︙ | |||
3789 3790 3791 3792 3793 3794 3795 | * If the block ends a catch, the state for the successor is whatever * the state was on entry to the catch. */ if (enclosing == NULL) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 | * If the block ends a catch, the state for the successor is whatever * the state was on entry to the catch. */ if (enclosing == NULL) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "endCatch without a corresponding beginCatch", -1)); Tcl_SetErrorLine(interp, bbPtr->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL); } return TCL_ERROR; } fallThruEnclosing = enclosing->enclosingCatch; fallThruState = enclosing->catchState; |
︙ | ︙ | |||
3864 3865 3866 3867 3868 3869 3870 | /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 | /* Compilation environment */ Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr; /* Tcl interpreter */ if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) { if (assemEnvPtr->flags & TCL_EVAL_DIRECT) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "catch still active on exit from assembly code", -1)); Tcl_SetErrorLine(interp, assemEnvPtr->curr_bb->enclosingCatch->startLine); Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL); } return TCL_ERROR; } return TCL_OK; |
︙ | ︙ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
89 90 91 92 93 94 95 | typedef struct { Tcl_Interp *interp; /* Interp this struct belongs to. */ Tcl_AsyncHandler async; /* Async handler token for script * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ | | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | typedef struct { Tcl_Interp *interp; /* Interp this struct belongs to. */ Tcl_AsyncHandler async; /* Async handler token for script * cancellation. */ char *result; /* The script cancellation result or NULL for * a default result. */ Tcl_Size length; /* Length of the above error message. */ void *clientData; /* Not used. */ int flags; /* Additional flags */ } CancelInfo; static Tcl_HashTable cancelTable; static int cancelTableInitialized = 0; /* 0 means not yet initialized. */ TCL_DECLARE_MUTEX(cancelLock); |
︙ | ︙ | |||
216 217 218 219 220 221 222 | * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ #define CORO_ACTIVATE_YIELD NULL #define CORO_ACTIVATE_YIELDM INT2PTR(1) | | | | 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | * Magical counts for the number of arguments accepted by a coroutine command * after particular kinds of [yield]. */ #define CORO_ACTIVATE_YIELD NULL #define CORO_ACTIVATE_YIELDM INT2PTR(1) #define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) #define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. */ typedef struct { const char *name; /* Name of object-based command. */ |
︙ | ︙ | |||
609 610 611 612 613 614 615 | *---------------------------------------------------------------------- */ static int buildInfoObjCmd2( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ | | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | *---------------------------------------------------------------------- */ static int buildInfoObjCmd2( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; } if (objc == 2) { Tcl_Size len; const char *arg = Tcl_GetStringFromObj(objv[1], &len); if (len == 7 && !strcmp(arg, "version")) { char buf[80]; const char *p = strchr((char *)clientData, '.'); if (p) { const char *q = strchr(p+1, '.'); const char *r = strchr(p+1, '+'); |
︙ | ︙ | |||
698 699 700 701 702 703 704 | static int buildInfoObjCmd( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 | static int buildInfoObjCmd( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { return buildInfoObjCmd2(clientData, interp, objc, objv); } /* *---------------------------------------------------------------------- * * Tcl_CreateInterp -- * |
︙ | ︙ | |||
1795 1796 1797 1798 1799 1800 1801 | Tcl_Interp *interp) /* Interpreter to delete. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; | | | 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 | Tcl_Interp *interp) /* Interpreter to delete. */ { Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hPtr; Tcl_HashSearch search; Tcl_HashTable *hTablePtr; ResolverScheme *resPtr, *nextResPtr; Tcl_Size i; /* * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup, * unless we are exiting. */ if ((iPtr->numLevels > 0) && !TclInExit()) { |
︙ | ︙ | |||
2148 2149 2150 2151 2152 2153 2154 | * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" | | | 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 | * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL); return TCL_ERROR; } /* * Find the command to hide. An error is returned if cmdName can't be * found. Look up the command only from the global namespace. Full path of |
︙ | ︙ | |||
2661 2662 2663 2664 2665 2666 2667 | int objc, Tcl_Obj * const *objv) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } | | | 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 | int objc, Tcl_Obj * const *objv) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } return info->proc(info->clientData, interp, objc, objv); } static void cmdWrapperDeleteProc(void *clientData) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; |
︙ | ︙ | |||
3184 3185 3186 3187 3188 3189 3190 | * The trace function needs to get a fully qualified name for old and new * commands [Tcl bug #651271], or else there's no way for the trace * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); | | | | 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 | * The trace function needs to get a fully qualified name for old and new * commands [Tcl bug #651271], or else there's no way for the trace * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, -1); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); /* * The new command name is okay, so remove the command from its current |
︙ | ︙ | |||
3287 3288 3289 3290 3291 3292 3293 | *---------------------------------------------------------------------- */ static int invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ | | | | | 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 | *---------------------------------------------------------------------- */ static int invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { objc = TCL_INDEX_NONE; /* TODO - why? Should error, not truncate */ } if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } else { result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc, cmdPtr->objClientData, objc, objv); } return result; } static int cmdWrapper2Proc(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]) { Command *cmdPtr = (Command *)clientData; return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } int |
︙ | ︙ | |||
3549 3550 3551 3552 3553 3554 3555 | /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { | | | | 3549 3550 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 | /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1); if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, -1); } } } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4057 4058 4059 4060 4061 4062 4063 | /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 | /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to call eval in deleted interpreter", -1)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", NULL); return TCL_ERROR; } if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; |
︙ | ︙ | |||
4086 4087 4088 4089 4090 4091 4092 | */ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 | */ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested evaluations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4195 4196 4197 4198 4199 4200 4201 | /* * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the * interp's result; otherwise, we leave it alone. */ if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; | | | 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 | /* * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the * interp's result; otherwise, we leave it alone. */ if (flags & TCL_LEAVE_ERR_MSG) { const char *id, *message = NULL; Tcl_Size length; /* * Setup errorCode variables so that we can differentiate between * being canceled and unwound. */ if (iPtr->asyncCancelMsg != NULL) { |
︙ | ︙ | |||
4220 4221 4222 4223 4224 4225 4226 | } else { id = "ICANCEL"; if (length == 0) { message = "eval canceled"; } } | | | 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 | } else { id = "ICANCEL"; if (length == 0) { message = "eval canceled"; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL); } /* * Return TCL_ERROR to the caller (not necessarily just the Tcl core * itself) that indicates further processing of the script or command in * progress should halt gracefully and as soon as possible. |
︙ | ︙ | |||
4366 4367 4368 4369 4370 4371 4372 | *---------------------------------------------------------------------- */ int Tcl_EvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ | | | | 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 | *---------------------------------------------------------------------- */ int Tcl_EvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ { int result; NRE_callback *rootPtr = TOP_CB(interp); result = TclNREvalObjv(interp, objc, objv, flags, NULL); return TclNRRunCallbacks(interp, result, rootPtr); } int TclNREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ Command *cmdPtr) /* NULL if the Command is to be looked up |
︙ | ︙ | |||
4793 4794 4795 4796 4797 4798 4799 | void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; | | | 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 | void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; Tcl_Size cmdLen; int objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the |
︙ | ︙ | |||
4822 4823 4824 4825 4826 4827 4828 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Command * cmdPtr; Interp *iPtr = (Interp *) interp; | | | 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Command * cmdPtr; Interp *iPtr = (Interp *) interp; Tcl_Size i, newObjc, handlerObjc; Tcl_Obj **newObjv, **handlerObjv; CallFrame *varFramePtr = iPtr->varFramePtr; Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered * unknown command handler for the current * namespace (TIP 181). */ Namespace *savedNsPtr = NULL; |
︙ | ︙ | |||
4949 4950 4951 4952 4953 4954 4955 | Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; | | | 4949 4950 4951 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 | Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; Tcl_Size length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; const char *command = Tcl_GetStringFromObj(commandPtr, &length); /* * Call trace functions. * Execute any command or execution traces. Note that we bump up the * command's reference count for the duration of the calling of the |
︙ | ︙ | |||
5002 5003 5004 5005 5006 5007 5008 | { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; | | | 5002 5003 5004 5005 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 | { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; int objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; Tcl_Size length; const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } |
︙ | ︙ | |||
5085 5086 5087 5088 5089 5090 5091 | int Tcl_EvalTokensStandard( Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ | | | 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 | int Tcl_EvalTokensStandard( Tcl_Interp *interp, /* Interpreter in which to lookup variables, * execute nested commands, and report * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, NULL, NULL); } /* |
︙ | ︙ | |||
5118 5119 5120 5121 5122 5123 5124 | */ int Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ | | | | | 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 5151 5152 5153 | */ int Tcl_EvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ Tcl_Size numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first null character. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ { return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script); } int TclEvalEx( Tcl_Interp *interp, /* Interpreter in which to evaluate the * script. Also used for error reporting. */ const char *script, /* First character of script to evaluate. */ Tcl_Size numBytes, /* Number of bytes in script. If -1, the * script consists of all bytes up to the * first NUL character. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ int *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' * refers to the most-outer script containing * the embedded command, which is referred to * by 'script'. The 'clNextOuter' refers to |
︙ | ︙ | |||
5165 5166 5167 5168 5169 5170 5171 | Interp *iPtr = (Interp *) interp; const char *p, *next; const unsigned int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; int bytesLeft, expandRequested, code = TCL_OK; | | | 5165 5166 5167 5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 | Interp *iPtr = (Interp *) interp; const char *p, *next; const unsigned int minObjs = 20; Tcl_Obj **objv, **objvSpace; int *expand, *lines, *lineSpace; Tcl_Token *tokenPtr; int bytesLeft, expandRequested, code = TCL_OK; Tcl_Size commandLength; CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; TCL_HASH_TYPE i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating |
︙ | ︙ | |||
5199 5200 5201 5202 5203 5204 5205 | if (clNextOuter) { clNext = clNextOuter; } else { clNext = &iPtr->scriptCLLocPtr->loc[0]; } } | | | 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 | if (clNextOuter) { clNext = clNextOuter; } else { clNext = &iPtr->scriptCLLocPtr->loc[0]; } } if (numBytes < 0) { numBytes = strlen(script); } Tcl_ResetResult(interp); savedVarFramePtr = iPtr->varFramePtr; if (flags & TCL_EVAL_GLOBAL) { iPtr->varFramePtr = iPtr->rootFramePtr; |
︙ | ︙ | |||
5305 5306 5307 5308 5309 5310 5311 | /* * TIP #280. Track lines within the words of the current * command. We use a separate pointer into the table of * continuation line locations to not lose our position for the * per-command parsing. */ | | | 5305 5306 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 | /* * TIP #280. Track lines within the words of the current * command. We use a separate pointer into the table of * continuation line locations to not lose our position for the * per-command parsing. */ Tcl_Size wordLine = line; const char *wordStart = parsePtr->commandStart; int *wordCLNext = clNext; unsigned int objectsNeeded = 0; unsigned int numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. |
︙ | ︙ | |||
5360 5361 5362 5363 5364 5365 5366 | if (code != TCL_OK) { break; } objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { | | | 5360 5361 5362 5363 5364 5365 5366 5367 5368 5369 5370 5371 5372 5373 5374 | if (code != TCL_OK) { break; } objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { Tcl_Size numElements; code = TclListObjLengthM(interp, objv[objectsUsed], &numElements); if (code == TCL_ERROR) { /* * Attempt to expand a non-list. */ |
︙ | ︙ | |||
5411 5412 5413 5414 5415 5416 5417 | (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { | | | 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 5421 5422 5423 5424 5425 | (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { Tcl_Size numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; TclListObjGetElementsM(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { lines[objIdx] = -1; |
︙ | ︙ | |||
5604 5605 5606 5607 5608 5609 5610 | * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceLines( | | | 5604 5605 5606 5607 5608 5609 5610 5611 5612 5613 5614 5615 5616 5617 5618 | * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceLines( Tcl_Size *line, const char *start, const char *end) { const char *p; for (p = start; p < end; p++) { if (*p == '\n') { |
︙ | ︙ | |||
5639 5640 5641 5642 5643 5644 5645 | * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceContinuations( | | | 5639 5640 5641 5642 5643 5644 5645 5646 5647 5648 5649 5650 5651 5652 5653 | * * TIP #280 *---------------------------------------------------------------------- */ void TclAdvanceContinuations( Tcl_Size *line, int **clNextPtrPtr, int loc) { /* * Track the invisible continuation lines embedded in a script, if any. * Here they are just spaces (already). They were removed by * TclSubstTokens via TclParseBackslash. |
︙ | ︙ | |||
5819 5820 5821 5822 5823 5824 5825 | TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, | | | 5819 5820 5821 5822 5823 5824 5825 5826 5827 5828 5829 5830 5831 5832 5833 | TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], int objc, void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc) { ExtCmdLoc *eclPtr; int word; ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hePtr = |
︙ | ︙ | |||
5848 5849 5850 5851 5852 5853 5854 | * ensemble dispatch. Ensemble subcommands that lead to script * evaluation are not supposed to get compiled, because a command * such as [info level] in the script can expose some of the dispatch * shenanigans. This means that we don't have to tend to the * housekeeping, and can escape now. */ | | | 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 | * ensemble dispatch. Ensemble subcommands that lead to script * evaluation are not supposed to get compiled, because a command * such as [info level] in the script can expose some of the dispatch * shenanigans. This means that we don't have to tend to the * housekeeping, and can escape now. */ if (ePtr->nline != objc) { return; } /* * Having disposed of the ensemble cases, we can state... * A few truths ... * (1) ePtr->nline == objc |
︙ | ︙ | |||
6108 6109 6110 6111 6112 6113 6114 | * This function consists of three independent blocks for: direct * evaluation of canonical lists, compilation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; | | | 6108 6109 6110 6111 6112 6113 6114 6115 6116 6117 6118 6119 6120 6121 6122 | * This function consists of three independent blocks for: direct * evaluation of canonical lists, compilation and bytecode execution and * finally direct evaluation. Precisely one of these blocks will be run. */ if (TclListObjIsCanonical(objPtr)) { CmdFrame *eoFramePtr = NULL; Tcl_Size objc; Tcl_Obj *listPtr, **objv; /* * Canonical List Optimization: In this case, we * can safely use Tcl_EvalObjv instead and get an appreciable * improvement in execution speed. This is because it allows us to * avoid a setFromAny step that would just pack everything into a |
︙ | ︙ | |||
6218 6219 6220 6221 6222 6223 6224 | /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; | | | 6218 6219 6220 6221 6222 6223 6224 6225 6226 6227 6228 6229 6230 6231 6232 | /* * We're not supposed to use the compiler or byte-code * interpreter. Let Tcl_EvalEx evaluate the command directly (and * probably more slowly). */ const char *script; Tcl_Size numSrcBytes; /* * Now we check if we have data about invisible continuation lines for * the script, and make it available to the direct script parser and * evaluator we are about to call, if so. * * It may be possible that the script Tcl_Obj* can be free'd while the |
︙ | ︙ | |||
6272 6273 6274 6275 6276 6277 6278 | if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; | | | 6272 6273 6274 6275 6276 6277 6278 6279 6280 6281 6282 6283 6284 6285 6286 | if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { const char *script; Tcl_Size numSrcBytes; ProcessUnexpectedResult(interp, result); result = TCL_ERROR; script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); Tcl_LogCommandInfo(interp, script, script, numSrcBytes); } |
︙ | ︙ | |||
6357 6358 6359 6360 6361 6362 6363 | int returnCode) /* The unexpected result code. */ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 6357 6358 6359 6360 6361 6362 6363 6364 6365 6366 6367 6368 6369 6370 6371 6372 6373 6374 | int returnCode) /* The unexpected result code. */ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"break\" outside of a loop", -1)); } else if (returnCode == TCL_CONTINUE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"continue\" outside of a loop", -1)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); } snprintf(buf, sizeof(buf), "%d", returnCode); Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL); } |
︙ | ︙ | |||
6406 6407 6408 6409 6410 6411 6412 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; } else { | | | 6406 6407 6408 6409 6410 6411 6412 6413 6414 6415 6416 6417 6418 6419 6420 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); } return result; } |
︙ | ︙ | |||
6431 6432 6433 6434 6435 6436 6437 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0.0; } else { | | | 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 6441 6442 6443 6444 6445 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0.0; } else { exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ } return result; } |
︙ | ︙ | |||
6456 6457 6458 6459 6460 6461 6462 | * An empty string. Just set the result boolean to 0 (false). */ *ptr = 0; return TCL_OK; } else { int result; | | | 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 6466 6467 6468 6469 6470 | * An empty string. Just set the result boolean to 0 (false). */ *ptr = 0; return TCL_OK; } else { int result; Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); return result; } } |
︙ | ︙ | |||
6669 6670 6671 6672 6673 6674 6675 | * or TCL_INVOKE_NO_TRACEBACK. */ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 6669 6670 6671 6672 6673 6674 6675 6676 6677 6678 6679 6680 6681 6682 6683 | * or TCL_INVOKE_NO_TRACEBACK. */ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal argument vector", -1)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); } |
︙ | ︙ | |||
6768 6769 6770 6771 6772 6773 6774 | if (expr[0] == '\0') { /* * An empty string. Just set the interpreter's result to 0. */ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { | | | 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 | if (expr[0] == '\0') { /* * An empty string. Just set the interpreter's result to 0. */ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); Tcl_IncrRefCount(exprObj); code = Tcl_ExprObj(interp, exprObj, &resultPtr); Tcl_DecrRefCount(exprObj); if (code == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); |
︙ | ︙ | |||
6806 6807 6808 6809 6810 6811 6812 | void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { | | | 6806 6807 6808 6809 6810 6811 6812 6813 6814 6815 6816 6817 6818 6819 6820 | void Tcl_AppendObjToErrorInfo( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ Tcl_Obj *objPtr) /* Message to record. */ { Tcl_Size length; const char *message = Tcl_GetStringFromObj(objPtr, &length); Interp *iPtr = (Interp *) interp; Tcl_IncrRefCount(objPtr); /* * If we are just starting to log an error, errorInfo is initialized from |
︙ | ︙ | |||
6882 6883 6884 6885 6886 6887 6888 | Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); if (string == NULL) { break; } | | | | 6882 6883 6884 6885 6886 6887 6888 6889 6890 6891 6892 6893 6894 6895 6896 6897 6898 6899 | Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); if (string == NULL) { break; } Tcl_DStringAppend(&buf, string, -1); } result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); Tcl_DStringFree(&buf); return result; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
6907 6908 6909 6910 6911 6912 6913 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | | 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 6929 6930 6931 | * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Size Tcl_SetRecursionLimit( Tcl_Interp *interp, /* Interpreter whose nesting limit is to be * set. */ Tcl_Size depth) /* New value for maximimum depth. */ { Interp *iPtr = (Interp *) interp; Tcl_Size old; old = iPtr->maxNestingDepth; if (depth > 0) { iPtr->maxNestingDepth = depth; } return old; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
7188 7189 7190 7191 7192 7193 7194 | } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 | } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "square root of negative argument", -1)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); return TCL_ERROR; } static int ExprSqrtFunc( |
︙ | ︙ | |||
7390 7391 7392 7393 7394 7395 7396 | if (type == TCL_NUMBER_INT) { Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > 0) { goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { | | | 7390 7391 7392 7393 7394 7395 7396 7397 7398 7399 7400 7401 7402 7403 7404 | if (type == TCL_NUMBER_INT) { Tcl_WideInt l = *((const Tcl_WideInt *) ptr); if (l > 0) { goto unChanged; } else if (l == 0) { if (TclHasStringRep(objv[1])) { Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes); while (numBytes) { if (*bytes == '-') { Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } |
︙ | ︙ | |||
8470 8471 8472 8473 8474 8475 8476 | */ int Tcl_NRCallObjProc( Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, | | | 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 | */ int Tcl_NRCallObjProc( Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, Tcl_Size objc, Tcl_Obj *const objv[]) { NRE_callback *rootPtr = TOP_CB(interp); TclNRAddCallback(interp, Dispatch, objProc, clientData, INT2PTR(objc), objv); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); |
︙ | ︙ | |||
8493 8494 8495 8496 8497 8498 8499 | CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } | | | | 8493 8494 8495 8496 8497 8498 8499 8500 8501 8502 8503 8504 8505 8506 8507 8508 8509 8510 8511 8512 8513 8514 8515 | CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } return proc(clientData, interp, (Tcl_Size)objc, objv); } int Tcl_NRCallObjProc2( Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]) { if (objc > INT_MAX) { Tcl_WrongNumArgs(interp, 1, objv, "?args?"); return TCL_ERROR; } |
︙ | ︙ | |||
8557 8558 8559 8560 8561 8562 8563 | int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } | | | 8557 8558 8559 8560 8561 8562 8563 8564 8565 8566 8567 8568 8569 8570 8571 | int objc, Tcl_Obj *const objv[]) { CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; if (objc < 0) { objc = -1; } return info->nreProc(info->clientData, interp, objc, objv); } Tcl_Command Tcl_NRCreateCommand2( Tcl_Interp *interp, /* Token for command interpreter (returned by * previous call to Tcl_CreateInterp). */ const char *cmdName, /* Name of command. If it contains namespace |
︙ | ︙ | |||
8653 8654 8655 8656 8657 8658 8659 | return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN); } int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ | | | | 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 | return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN); } int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and * TCL_EVAL_NOERR are currently supported. */ { return TclNREvalObjv(interp, objc, objv, flags, NULL); } int Tcl_NRCmdSwap( Tcl_Interp *interp, Tcl_Command cmd, Tcl_Size objc, Tcl_Obj *const objv[], int flags) { return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR, (Command *) cmd); } |
︙ | ︙ | |||
8802 8803 8804 8805 8806 8807 8808 | if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 8802 8803 8804 8805 8806 8807 8808 8809 8810 8811 8812 8813 8814 8815 8816 | if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc, lambda or method", -1)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); return TCL_ERROR; } /* * Invocation without args just clears a scheduled tailcall; invocation * with an argument replaces any previously scheduled tailcall. |
︙ | ︙ | |||
8832 8833 8834 8835 8836 8837 8838 | Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ | | | 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 8843 8844 8845 8846 | Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } |
︙ | ︙ | |||
8860 8861 8862 8863 8864 8865 8866 | void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; | | | 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 8873 8874 | void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; Tcl_Size objc; Tcl_Obj **objv; TclListObjGetElementsM(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; if (result == TCL_OK) { result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr); |
︙ | ︙ | |||
8964 8965 8966 8967 8968 8969 8970 | if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 8964 8965 8966 8967 8968 8969 8970 8971 8972 8973 8974 8975 8976 8977 8978 | if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } |
︙ | ︙ | |||
8997 8998 8999 9000 9001 9002 9003 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | | 8997 8998 8999 9000 9001 9002 9003 9004 9005 9006 9007 9008 9009 9010 9011 9012 9013 9014 9015 9016 9017 9018 9019 9020 9021 9022 9023 9024 9025 9026 9027 9028 9029 9030 9031 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto can only be called in a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", NULL); return TCL_ERROR; } /* * Add the tailcall in the caller env, then just yield. * * This is essentially code from TclNRTailcallObjCmd */ listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; |
︙ | ︙ | |||
9208 9209 9210 9211 9212 9213 9214 | /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = &corPtr; | | | 9208 9209 9210 9211 9212 9213 9214 9215 9216 9217 9218 9219 9220 9221 9222 | /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = &corPtr; Tcl_Size numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; SAVE_CONTEXT(corPtr->caller); corPtr->callerEEPtr = iPtr->execEnvPtr; RESTORE_CONTEXT(corPtr->running); iPtr->execEnvPtr = corPtr->eePtr; iPtr->numLevels += numLevels; |
︙ | ︙ | |||
9239 9240 9241 9242 9243 9244 9245 | } } } iPtr->execEnvPtr = corPtr->eePtr; Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 9239 9240 9241 9242 9243 9244 9245 9246 9247 9248 9249 9250 9251 9252 9253 9254 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 | } } } iPtr->execEnvPtr = corPtr->eePtr; Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot yield: C stack busy", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", NULL); return TCL_ERROR; } void *type = data[1]; if (type == CORO_ACTIVATE_YIELD) { corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; } else if (type == CORO_ACTIVATE_YIELDM) { corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; } else { Tcl_Panic("Yield received an option which is not implemented"); } corPtr->yieldPtr = NULL; corPtr->stackLevel = NULL; Tcl_Size numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; |
︙ | ︙ | |||
9284 9285 9286 9287 9288 9289 9290 | static int TclNREvalList( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | 9284 9285 9286 9287 9288 9289 9290 9291 9292 9293 9294 9295 9296 9297 9298 | static int TclNREvalList( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { Tcl_Size objc; Tcl_Obj **objv; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); |
︙ | ︙ | |||
9328 9329 9330 9331 9332 9333 9334 | /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | | | | 9328 9329 9330 9331 9332 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 | /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only get coroutine type of a coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), NULL); return TCL_ERROR; } /* * An active coroutine is "active". Can't tell what it might do in the * future. */ corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); return TCL_OK; default: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown coroutine type", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
9388 9389 9390 9391 9392 9393 9394 | /* * How to get a coroutine from its handle. */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { | | | 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 9400 9401 9402 | /* * How to get a coroutine from its handle. */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), NULL); return NULL; } return (CoroutineData *)cmdPtr->objClientData; } |
︙ | ︙ | |||
9422 9423 9424 9425 9426 9427 9428 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 9434 9435 9436 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. |
︙ | ︙ | |||
9500 9501 9502 9503 9504 9505 9506 | /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = &corPtr; | | | 9500 9501 9502 9503 9504 9505 9506 9507 9508 9509 9510 9511 9512 9513 9514 | /* * Record the stackLevel at which the resume is happening, then swap * the interp's environment to make it suitable to run this coroutine. */ corPtr->stackLevel = &corPtr; Tcl_Size numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; /* * Do the actual stack swap. */ SAVE_CONTEXT(corPtr->caller); |
︙ | ︙ | |||
9544 9545 9546 9547 9548 9549 9550 | InjectHandler( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; | | | | 9544 9545 9546 9547 9548 9549 9550 9551 9552 9553 9554 9555 9556 9557 9558 9559 9560 | InjectHandler( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; Tcl_Size objc; Tcl_Obj **objv; if (!isProbe) { /* * If this is [coroinject], add the extra arguments now. */ |
︙ | ︙ | |||
9591 9592 9593 9594 9595 9596 9597 | InjectHandlerPostCall( void *data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; | | | 9591 9592 9593 9594 9595 9596 9597 9598 9599 9600 9601 9602 9603 9604 9605 | InjectHandlerPostCall( void *data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; /* * Delete the command words for what we just executed. */ Tcl_DecrRefCount(listPtr); |
︙ | ︙ | |||
9614 9615 9616 9617 9618 9619 9620 | if (isProbe) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (injected coroutine probe command)"); } corPtr->nargs = nargs; corPtr->stackLevel = NULL; | | | 9614 9615 9616 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 | if (isProbe) { if (result == TCL_ERROR) { Tcl_AddErrorInfo(interp, "\n (injected coroutine probe command)"); } corPtr->nargs = nargs; corPtr->stackLevel = NULL; Tcl_Size numLevels = iPtr->numLevels; iPtr->numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } |
︙ | ︙ | |||
9659 9660 9661 9662 9663 9664 9665 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 9659 9660 9661 9662 9663 9664 9665 9666 9667 9668 9669 9670 9671 9672 9673 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", -1)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. |
︙ | ︙ | |||
9710 9711 9712 9713 9714 9715 9716 | Tcl_SetObjResult(interp, objv[1]); } else if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; } break; default: | | | | 9710 9711 9712 9713 9714 9715 9716 9717 9718 9719 9720 9721 9722 9723 9724 9725 9726 9727 | Tcl_SetObjResult(interp, objv[1]); } else if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); return TCL_ERROR; } break; default: if (corPtr->nargs + 1 != objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " "not implemented!", -1)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); |
︙ | ︙ |
Changes to generic/tclBinary.c.
︙ | ︙ | |||
18 19 20 21 22 23 24 | #include <assert.h> /* * The following constants are used by GetFormatSpec to indicate various * special conditions in the parsing of a format specifier. */ | | | | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | #include <assert.h> /* * The following constants are used by GetFormatSpec to indicate various * special conditions in the parsing of a format specifier. */ #define BINARY_ALL -1 /* Use all elements in the argument. */ #define BINARY_NOCOUNT -2 /* No count was specified in format. */ /* * The following flags may be OR'ed together and returned by GetFormatSpec */ #define BINARY_SIGNED 0 /* Field to be read as signed data */ #define BINARY_UNSIGNED 1 /* Field to be read as unsigned data */ |
︙ | ︙ | |||
57 58 59 60 61 62 63 | static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, | | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int FormatNumber(Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr); static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr); static int GetFormatSpec(const char **formatPtr, char *cmdPtr, Tcl_Size *countPtr, int *flagsPtr); static Tcl_Obj * ScanNumber(unsigned char *buffer, int type, int flags, Tcl_HashTable **numberCachePtr); static int SetByteArrayFromAny(Tcl_Interp *interp, Tcl_Size limit, Tcl_Obj *objPtr); static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, size_t length, int type); /* Binary ensemble commands */ |
︙ | ︙ | |||
170 171 172 173 174 175 176 | * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ typedef struct { | | | > < > | | 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 | * The following structure is the internal rep for a ByteArray object. Keeps * track of how much memory has been used and how much has been allocated for * the byte array to enable growing and shrinking of the ByteArray object with * fewer mallocs. */ typedef struct { Tcl_Size used; /* The number of bytes used in the byte * array. */ Tcl_Size allocated; /* The amount of space actually allocated * minus 1 byte. */ unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_MAX_LEN (TCL_SIZE_MAX - (Tcl_Size)offsetof(ByteArray, bytes)) #define BYTEARRAY_SIZE(len) \ ( (len < 0 || BYTEARRAY_MAX_LEN < (len)) \ ? (Tcl_Panic("negative length specified or max size of a Tcl value exceeded"), 0) \ : (offsetof(ByteArray, bytes) + (len)) ) #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) #define SET_BYTEARRAY(irPtr, baPtr) \ (irPtr)->twoPtrValue.ptr1 = (baPtr) int TclIsPureByteArray( |
︙ | ︙ | |||
218 219 220 221 222 223 224 | #undef Tcl_NewByteArrayObj Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ | | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | #undef Tcl_NewByteArrayObj Tcl_Obj * Tcl_NewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ Tcl_Size numBytes) /* Number of bytes in the array */ { #ifdef TCL_MEM_DEBUG return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0); #else /* if not TCL_MEM_DEBUG */ Tcl_Obj *objPtr; TclNewObj(objPtr); |
︙ | ︙ | |||
261 262 263 264 265 266 267 | */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ | | | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 | */ #ifdef TCL_MEM_DEBUG Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ Tcl_Size numBytes, /* Number of bytes in the array */ const char *file, /* The name of the source file calling this * procedure; used for debugging. */ int line) /* Line number in the source file; used for * debugging. */ { Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); Tcl_SetByteArrayObj(objPtr, bytes, numBytes); return objPtr; } #else /* if not TCL_MEM_DEBUG */ Tcl_Obj * Tcl_DbNewByteArrayObj( const unsigned char *bytes, /* The array of bytes used to initialize the * new object. */ Tcl_Size numBytes, /* Number of bytes in the array */ TCL_UNUSED(const char *) /*file*/, TCL_UNUSED(int) /*line*/) { return Tcl_NewByteArrayObj(bytes, numBytes); } #endif /* TCL_MEM_DEBUG */ |
︙ | ︙ | |||
309 310 311 312 313 314 315 | */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if numBytes > 0. */ | | > > | 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 | */ void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ const unsigned char *bytes, /* The array of bytes to use as the new value. * May be NULL even if numBytes > 0. */ Tcl_Size numBytes) /* Number of bytes in the array. * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); } TclInvalidateStringRep(objPtr); assert(numBytes >= 0); byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); byteArrayPtr->used = numBytes; byteArrayPtr->allocated = numBytes; if ((bytes != NULL) && (numBytes > 0)) { memcpy(byteArrayPtr->bytes, bytes, numBytes); } |
︙ | ︙ | |||
353 354 355 356 357 358 359 | */ #undef Tcl_GetBytesFromObj unsigned char * Tcl_GetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ | | | 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | */ #undef Tcl_GetBytesFromObj unsigned char * Tcl_GetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ Tcl_Size *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { ByteArray *baPtr; const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { |
︙ | ︙ | |||
382 383 384 385 386 387 388 | unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { | | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | unsigned char * TclGetBytesFromObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj *objPtr, /* Value to extract from */ int *numBytesPtr) /* If non-NULL, write the number of bytes * in the array here */ { Tcl_Size numBytes = 0; unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes); if (bytes && numBytesPtr) { if (numBytes > INT_MAX) { /* Caller asked for numBytes to be written to an int, but the * value is outside the int range. */ if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "byte sequence length exceeds INT_MAX", -1)); Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL); } return NULL; } else { *numBytesPtr = (int) numBytes; } } |
︙ | ︙ | |||
429 430 431 432 433 434 435 | * *---------------------------------------------------------------------- */ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ | | > > | 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 | * *---------------------------------------------------------------------- */ unsigned char * Tcl_SetByteArrayLength( Tcl_Obj *objPtr, /* The ByteArray object. */ Tcl_Size numBytes) /* Number of bytes in resized array * Must be >= 0 */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep *irPtr; assert(numBytes >= 0); if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength"); } irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); if (irPtr == NULL) { if (TCL_ERROR == SetByteArrayFromAny(NULL, numBytes, objPtr)) { |
︙ | ︙ | |||
464 465 466 467 468 469 470 | /* *---------------------------------------------------------------------- * * MakeByteArray -- * * Generate a ByteArray internal rep from the string rep of objPtr. | | | | | < | | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 | /* *---------------------------------------------------------------------- * * MakeByteArray -- * * Generate a ByteArray internal rep from the string rep of objPtr. * The generated byte sequence may have no more than limit bytes. * A negative value for limit indicates no limit imposed. If * boolean argument demandProper is true, then no byte sequence should * be output to the caller (write NULL instead). When no bytes sequence * is output and interp is not NULL, leave an error message and error * code in interp explaining why a proper byte sequence could not be * made. * * Results: * Returns a boolean indicating whether the bytes generated (up to * limit bytes) are a proper representation of (a limited prefix of) * the string. Writes a pointer to the generated ByteArray to * *byteArrayPtrPtr. If not NULL it needs to be released with Tcl_Free(). * *---------------------------------------------------------------------- */ static int MakeByteArray( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size limit, int demandProper, ByteArray **byteArrayPtrPtr) { Tcl_Size length; const char *src = Tcl_GetStringFromObj(objPtr, &length); Tcl_Size numBytes = (limit >= 0 && limit < length) ? limit : length; ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes)); unsigned char *dst = byteArrayPtr->bytes; unsigned char *dstEnd = dst + numBytes; const char *srcEnd = src + length; int proper = 1; for (; src < srcEnd && dst < dstEnd; ) { |
︙ | ︙ | |||
567 568 569 570 571 572 573 | * *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* For error reporting. */ | | | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 | * *---------------------------------------------------------------------- */ static int SetByteArrayFromAny( Tcl_Interp *interp, /* For error reporting. */ Tcl_Size limit, /* Create no more than this many bytes */ Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */ { ByteArray *byteArrayPtr; Tcl_ObjInternalRep ir; if (0 == MakeByteArray(interp, objPtr, limit, 1, &byteArrayPtr)) { return TCL_ERROR; |
︙ | ︙ | |||
628 629 630 631 632 633 634 | */ static void DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { | | | 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 | */ static void DupProperByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Tcl_Size length; ByteArray *srcArrayPtr, *copyArrayPtr; Tcl_ObjInternalRep ir; srcArrayPtr = GET_BYTEARRAY(TclFetchInternalRep(srcPtr, &properByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length)); |
︙ | ︙ | |||
669 670 671 672 673 674 675 | UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; | | | | 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 | UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &properByteArrayType); ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr); unsigned char *src = byteArrayPtr->bytes; Tcl_Size i, length = byteArrayPtr->used; Tcl_Size size = length; /* * How much space will string rep need? */ for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { |
︙ | ︙ | |||
719 720 721 722 723 724 725 | *---------------------------------------------------------------------- */ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, | | | | | 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 | *---------------------------------------------------------------------- */ void TclAppendBytesToByteArray( Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size len) { ByteArray *byteArrayPtr; Tcl_Size needed; Tcl_ObjInternalRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); } if (len < 0) { Tcl_Panic("%s must be called with definite number of bytes to append", "TclAppendBytesToByteArray"); } if (len == 0) { /* * Append zero bytes is a no-op. */ |
︙ | ︙ | |||
753 754 755 756 757 758 759 | } byteArrayPtr = GET_BYTEARRAY(irPtr); /* * If we need to, resize the allocated space in the byte array. */ | < | | | > | | | > | > | > > | | < | | | 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 | } byteArrayPtr = GET_BYTEARRAY(irPtr); /* * If we need to, resize the allocated space in the byte array. */ if ((BYTEARRAY_MAX_LEN - byteArrayPtr->used) < len) { /* Will wrap around !! */ Tcl_Panic("max size of a byte array exceeded"); } needed = byteArrayPtr->used + len; if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; /* * Try to allocate double the total space that is needed. */ Tcl_Size attempt; /* Make sure we do not wrap when doubling */ if (needed <= (BYTEARRAY_MAX_LEN - needed)) { attempt = 2 * needed; ptr = (ByteArray *) Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { /* * Try to allocate double the increment that is needed. * (Originally TCL_MIN_GROWTH was added as well but that would * need one more separate overflow check so forget it.) */ if (len <= (BYTEARRAY_MAX_LEN - needed)) { attempt = needed + len; ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } } if (ptr == NULL) { /* * Last chance: Try to allocate exactly what is needed. */ |
︙ | ︙ | |||
859 860 861 862 863 864 865 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ | | | | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ unsigned char *cursor; /* Current position within result buffer. */ unsigned char *maxPos; /* Greatest position within result buffer that * cursor has visited.*/ const char *errorString; const char *errorValue, *str; Tcl_Size offset, size, length; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "formatString ?arg ...?"); return TCL_ERROR; } /* |
︙ | ︙ | |||
969 970 971 972 973 974 975 | * non-list value. */ if (count == BINARY_NOCOUNT) { arg++; count = 1; } else { | | | 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 | * non-list value. */ if (count == BINARY_NOCOUNT) { arg++; count = 1; } else { Tcl_Size listc; Tcl_Obj **listv; /* * The macro evals its args more than once: avoid arg++ */ if (TclListObjLengthM(interp, objv[arg], &listc |
︙ | ︙ | |||
1001 1002 1003 1004 1005 1006 1007 | } offset += count*size; break; case 'x': if (count == BINARY_ALL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 | } offset += count*size; break; case 'x': if (count == BINARY_ALL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use \"*\" in format string with \"x\"", -1)); return TCL_ERROR; } else if (count == BINARY_NOCOUNT) { count = 1; } offset += count; break; case 'X': |
︙ | ︙ | |||
1251 1252 1253 1254 1255 1256 1257 | case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': case 'f': { | | | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 | case 'W': case 'r': case 'R': case 'd': case 'q': case 'Q': case 'f': { Tcl_Size listc, i; Tcl_Obj **listv; if (count == BINARY_NOCOUNT) { /* * Note that we are casting away the const-ness of objv, but * this is safe since we aren't going to modify the array. */ |
︙ | ︙ | |||
1292 1293 1294 1295 1296 1297 1298 | case 'X': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_NOCOUNT) { count = 1; } | | | 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 | case 'X': if (cursor > maxPos) { maxPos = cursor; } if (count == BINARY_NOCOUNT) { count = 1; } if ((count == BINARY_ALL) || (count > (cursor - buffer))) { cursor = buffer; } else { cursor -= count; } break; case '@': if (cursor > maxPos) { |
︙ | ︙ | |||
1341 1342 1343 1344 1345 1346 1347 | buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: | | | 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 | buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * BinaryScanCmd -- |
︙ | ︙ | |||
1372 1373 1374 1375 1376 1377 1378 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ | | | | 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int arg; /* Index of next argument to consume. */ int value = 0; /* Current integer value to be packed. * Initialized to avoid compiler warning. */ char cmd; /* Current format character. */ Tcl_Size count; /* Count associated with current format * character. */ int flags; /* Format field flags */ const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ const char *errorString; const char *str; Tcl_Size offset, size, length = 0, i; Tcl_Obj *valuePtr, *elementPtr; Tcl_HashTable numberCacheHash; Tcl_HashTable *numberCachePtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, |
︙ | ︙ | |||
1490 1491 1492 1493 1494 1495 1496 | } if (count == BINARY_ALL) { count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1; } | | | 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 | } if (count == BINARY_ALL) { count = (length - offset) * 8; } else { if (count == BINARY_NOCOUNT) { count = 1; } if (count > (length - offset) * 8) { goto done; } } src = buffer + offset; TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); |
︙ | ︙ | |||
1621 1622 1623 1624 1625 1626 1627 | scanNumber: if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_NOCOUNT) { | | | 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 | scanNumber: if (arg >= objc) { DeleteScanNumberCache(numberCachePtr); goto badIndex; } if (count == BINARY_NOCOUNT) { if (length < size + offset) { goto done; } valuePtr = ScanNumber(buffer+offset, cmd, flags, &numberCachePtr); offset += size; } else { if (count == BINARY_ALL) { |
︙ | ︙ | |||
1722 1723 1724 1725 1726 1727 1728 | buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: | | | 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 | buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad field specifier \"%s\"", buf)); return TCL_ERROR; } error: Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1)); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * GetFormatSpec -- |
︙ | ︙ | |||
1751 1752 1753 1754 1755 1756 1757 | *---------------------------------------------------------------------- */ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ | | | 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 | *---------------------------------------------------------------------- */ static int GetFormatSpec( const char **formatPtr, /* Pointer to format string. */ char *cmdPtr, /* Pointer to location of command char. */ Tcl_Size *countPtr, /* Pointer to repeat count value. */ int *flagsPtr) /* Pointer to field flags */ { /* * Skip any leading blanks. */ while (**formatPtr == ' ') { |
︙ | ︙ | |||
2455 2456 2457 2458 2459 2460 2461 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; | | | 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 | Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data = NULL; unsigned char *cursor = NULL; Tcl_Size offset = 0, count = 0; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "data"); return TCL_ERROR; } data = Tcl_GetBytesFromObj(interp, objv[1], &count); |
︙ | ︙ | |||
2504 2505 2506 2507 2508 2509 2510 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; int i, index, value, pure = 1, strict = 0; | | | 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor, c; int i, index, value, pure = 1, strict = 0; Tcl_Size size, cut = 0, count = 0; int ucs4; enum {OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; |
︙ | ︙ | |||
2629 2630 2631 2632 2633 2634 2635 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; unsigned char *data, *limit; int maxlen = 0; const char *wrapchar = "\n"; | | | | | 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj; unsigned char *data, *limit; int maxlen = 0; const char *wrapchar = "\n"; Tcl_Size wrapcharlen = 1; int i, index, size, outindex = 0, purewrap = 1; Tcl_Size offset, count = 0; enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } break; case OPT_WRAPCHAR: wrapchar = (const char *)Tcl_GetByteArrayFromObj( |
︙ | ︙ | |||
2758 2759 2760 2761 2762 2763 2764 | Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; int rawLength, i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; | | | 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 | Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; int rawLength, i, bits, index; unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; Tcl_Size j, offset, count = 0, wrapcharlen = sizeof(SingleNewline); enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; |
︙ | ︙ | |||
2780 2781 2782 2783 2784 2785 2786 | case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 5 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 | case OPT_MAXLEN: if (Tcl_GetIntFromObj(interp, objv[i + 1], &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 5 || lineLength > 85) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "line length out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", "LINE_LENGTH", NULL); return TCL_ERROR; } lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */ break; case OPT_WRAPCHAR: wrapchar = (const unsigned char *) Tcl_GetStringFromObj( objv[i + 1], &wrapcharlen); { const unsigned char *p = wrapchar; Tcl_Size numBytes = wrapcharlen; while (numBytes) { switch (*p) { case '\t': case '\v': case '\f': case '\r': |
︙ | ︙ | |||
2907 2908 2909 2910 2911 2912 2913 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, pure = 1, strict = 0, lineLen; | | | 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 | int objc, Tcl_Obj *const objv[]) { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend; unsigned char *begin, *cursor; int i, index, pure = 1, strict = 0, lineLen; Tcl_Size size, count = 0; unsigned char c; int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); |
︙ | ︙ | |||
3083 3084 3085 3086 3087 3088 3089 | { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend, c = '\0'; unsigned char *begin = NULL; unsigned char *cursor = NULL; int pure = 1, strict = 0; int i, index, cut = 0; | | | 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 | { Tcl_Obj *resultObj = NULL; unsigned char *data, *datastart, *dataend, c = '\0'; unsigned char *begin = NULL; unsigned char *cursor = NULL; int pure = 1, strict = 0; int i, index, cut = 0; Tcl_Size size, count = 0; int ucs4; enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclCkalloc.c.
︙ | ︙ | |||
185 186 187 188 189 190 191 | current_bytes_malloced, maximum_malloc_packets, maximum_bytes_malloced); if (flags == 0) { fprintf((FILE *)clientData, "%s", buf); } else { /* Assume objPtr to append to */ | | | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | current_bytes_malloced, maximum_malloc_packets, maximum_bytes_malloced); if (flags == 0) { fprintf((FILE *)clientData, "%s", buf); } else { /* Assume objPtr to append to */ Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1); } return 1; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
139 140 141 142 143 144 145 | /* * Function prototypes for local procedures in this file: */ static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, | | | | | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 | /* * Function prototypes for local procedures in this file: */ static int ConvertUTCToLocal(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertUTCToLocalUsingTable(Tcl_Interp *, TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertUTCToLocalUsingC(Tcl_Interp *, TclDateFields *, int); static int ConvertLocalToUTC(Tcl_Interp *, TclDateFields *, Tcl_Obj *, int); static int ConvertLocalToUTCUsingTable(Tcl_Interp *, TclDateFields *, Tcl_Size, Tcl_Obj *const[]); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); static Tcl_Obj * LookupLastTransition(Tcl_Interp *, Tcl_WideInt, Tcl_Size, Tcl_Obj *const *); static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); static void GetJulianDayFromEraYearWeekDay(TclDateFields *, int); static void GetJulianDayFromEraYearMonthDay(TclDateFields *, int); static int IsGregorianLeapYear(TclDateFields *); static int WeekdayOnOrBefore(int, int); |
︙ | ︙ | |||
724 725 726 727 728 729 730 | static int ConvertLocalToUTC( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { | | | 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 | static int ConvertLocalToUTC( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* * Unpack the tz data. */ if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { |
︙ | ︙ | |||
769 770 771 772 773 774 775 | *---------------------------------------------------------------------- */ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ | | | | 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 | *---------------------------------------------------------------------- */ static int ConvertLocalToUTCUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Time to convert, with 'seconds' filled in */ Tcl_Size rowc, /* Number of points at which time changes */ Tcl_Obj *const rowv[]) /* Points at which time changes */ { Tcl_Obj *row; Tcl_Size cellc; Tcl_Obj **cellv; int have[8]; int nHave = 0; int i; int found; /* |
︙ | ︙ | |||
927 928 929 930 931 932 933 | static int ConvertUTCToLocal( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { | | | 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 | static int ConvertUTCToLocal( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the time */ Tcl_Obj *tzdata, /* Time zone data */ int changeover) /* Julian Day of the Gregorian transition */ { Tcl_Size rowc; /* Number of rows in tzdata */ Tcl_Obj **rowv; /* Pointers to the rows */ /* * Unpack the tz data. */ if (TclListObjGetElementsM(interp, tzdata, &rowc, &rowv) != TCL_OK) { |
︙ | ︙ | |||
972 973 974 975 976 977 978 | *---------------------------------------------------------------------- */ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ | | | | 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 | *---------------------------------------------------------------------- */ static int ConvertUTCToLocalUsingTable( Tcl_Interp *interp, /* Tcl interpreter */ TclDateFields *fields, /* Fields of the date */ Tcl_Size rowc, /* Number of rows in the conversion table * (>= 1) */ Tcl_Obj *const rowv[]) /* Rows of the conversion table */ { Tcl_Obj *row; /* Row containing the current information */ Tcl_Size cellc; /* Count of cells in the row (must be 4) */ Tcl_Obj **cellv; /* Pointers to the cells */ /* * Look up the nearest transition time. */ row = LookupLastTransition(interp, fields->seconds, rowc, rowv); |
︙ | ︙ | |||
1112 1113 1114 1115 1116 1117 1118 | *---------------------------------------------------------------------- */ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ | | | | | 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 | *---------------------------------------------------------------------- */ static Tcl_Obj * LookupLastTransition( Tcl_Interp *interp, /* Interpreter for error messages */ Tcl_WideInt tick, /* Time from the epoch */ Tcl_Size rowc, /* Number of rows of tzdata */ Tcl_Obj *const *rowv) /* Rows in tzdata */ { Tcl_Size l; Tcl_Size u; Tcl_Obj *compObj; Tcl_WideInt compVal; /* * Examine the first row to make sure we're in bounds. */ |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
26 27 28 29 30 31 32 | */ struct ForeachState { Tcl_Obj *bodyPtr; /* The script body of the command. */ int bodyIdx; /* The argument index of the body. */ int j, maxj; /* Number of loop iterations. */ int numLists; /* Count of value lists. */ | | | | | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | */ struct ForeachState { Tcl_Obj *bodyPtr; /* The script body of the command. */ int bodyIdx; /* The argument index of the body. */ int j, maxj; /* Number of loop iterations. */ int numLists; /* Count of value lists. */ Tcl_Size *index; /* Array of value list indices. */ Tcl_Size *varcList; /* # loop variables per list. */ Tcl_Obj ***varvList; /* Array of var name lists. */ Tcl_Obj **vCopyList; /* Copies of var name list arguments. */ Tcl_Size *argcList; /* Array of value list sizes. */ Tcl_Obj ***argvList; /* Array of value lists. */ Tcl_Obj **aCopyList; /* Copies of value list arguments. */ Tcl_Obj *resultList; /* List of result values from the loop body, * or NULL if we're not collecting them * ([lmap] vs [foreach]). */ }; |
︙ | ︙ | |||
526 527 528 529 530 531 532 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ | | | 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* Byte array to convert */ Tcl_DString ds; /* Buffer to hold the string */ Tcl_Encoding encoding; /* Encoding to use */ Tcl_Size length = 0; /* Length of the byte array being converted */ const char *bytesPtr; /* Pointer to the first byte of the array */ int flags; int result; Tcl_Obj *failVarObj; Tcl_Size errorLocation; if (EncodingConvertParseOptions( |
︙ | ︙ | |||
626 627 628 629 630 631 632 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ | | | 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *data; /* String to convert */ Tcl_DString ds; /* Buffer to hold the byte array */ Tcl_Encoding encoding; /* Encoding to use */ Tcl_Size length; /* Length of the string being converted */ const char *stringPtr; /* Pointer to the first byte of the string */ int result; int flags; Tcl_Obj *failVarObj; Tcl_Size errorLocation; if (EncodingConvertParseOptions( |
︙ | ︙ | |||
2060 2061 2062 2063 2064 2065 2066 | { Tcl_Obj *res; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } | | | 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 | { Tcl_Obj *res; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "name"); return TCL_ERROR; } res = Tcl_FSSplitPath(objv[1], NULL); if (res == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not read \"%s\": no such file or directory", TclGetString(objv[1]))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH", NULL); return TCL_ERROR; |
︙ | ︙ | |||
2753 2754 2755 2756 2757 2758 2759 | * * The setting up of all of these pointers is moderately messy, but allows * the rest of this code to be simple and for us to use a single memory * allocation for better performance. */ statePtr = (struct ForeachState *)TclStackAlloc(interp, | | | | | 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 | * * The setting up of all of these pointers is moderately messy, but allows * the rest of this code to be simple and for us to use a single memory * allocation for better performance. */ statePtr = (struct ForeachState *)TclStackAlloc(interp, sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); memset(statePtr, 0, sizeof(struct ForeachState) + 3 * numLists * sizeof(Tcl_Size) + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *))); statePtr->varvList = (Tcl_Obj ***) (statePtr + 1); statePtr->argvList = statePtr->varvList + numLists; statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists); statePtr->aCopyList = statePtr->vCopyList + numLists; statePtr->index = (Tcl_Size *) (statePtr->aCopyList + numLists); statePtr->varcList = statePtr->index + numLists; statePtr->argcList = statePtr->varcList + numLists; statePtr->numLists = numLists; statePtr->bodyPtr = objv[objc - 1]; statePtr->bodyIdx = objc - 1; |
︙ | ︙ | |||
2942 2943 2944 2945 2946 2947 2948 | static inline int ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { int i; | | | 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 | static inline int ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { int i; Tcl_Size v, k; Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; i<statePtr->numLists ; i++) { int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType); for (v=0 ; v<statePtr->varcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
47 48 49 50 51 52 53 | /* * These function pointer types are used with the "lsearch" and "lsort" * commands to facilitate the "-nocase" option. */ typedef int (*SortStrCmpFn_t) (const char *, const char *); | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | /* * These function pointer types are used with the "lsearch" and "lsort" * commands to facilitate the "-nocase" option. */ typedef int (*SortStrCmpFn_t) (const char *, const char *); typedef int (*SortMemCmpFn_t) (const void *, const void *, Tcl_Size); /* * The "lsort" command needs to pass certain information down to the function * that compares two list elements, and the comparison function needs to pass * success or failure information back up to the top-level "lsort" command. * The following structure is used to pass this information. */ |
︙ | ︙ | |||
70 71 72 73 74 75 76 | int *indexv; /* If the -index option was specified, this * holds an encoding of the indexes contained * in the list supplied as an argument to * that option. * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | int *indexv; /* If the -index option was specified, this * holds an encoding of the indexes contained * in the list supplied as an argument to * that option. * NULL if no indexes supplied, and points to * singleIndex field when only one * supplied. */ Tcl_Size indexc; /* Number of indexes in indexv array. */ int singleIndex; /* Static space for common index case. */ int unique; int numElements; Tcl_Interp *interp; /* The interpreter in which the sort is being * done. */ int resultCode; /* Completion code for the lsort command. If * an error occurs during the sort this is |
︙ | ︙ | |||
500 501 502 503 504 505 506 | */ listObjPtr = Tcl_NewListObj(0, NULL); for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_ListObjAppendElement(interp, listObjPtr, | | | 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 | */ listObjPtr = Tcl_NewListObj(0, NULL); for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; localPtr = localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj(localPtr->name, -1)); } } Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } /* |
︙ | ︙ | |||
537 538 539 540 541 542 543 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; | | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; const char *name, *bytes; Proc *procPtr; Tcl_Size numBytes; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "procname"); return TCL_ERROR; } name = TclGetString(objv[1]); |
︙ | ︙ | |||
647 648 649 650 651 652 653 | Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; | | | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; Tcl_Size i; /* * Get the pattern and find the "effective namespace" in which to list * commands. */ if (objc == 1) { |
︙ | ︙ | |||
712 713 714 715 716 717 718 | if (entryPtr != NULL) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); | | | 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 | if (entryPtr != NULL) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } if ((nsPtr != globalNsPtr) && !specificNsInPattern) { Tcl_HashTable *tablePtr = NULL; /* Quell warning. */ |
︙ | ︙ | |||
740 741 742 743 744 745 746 | if (entryPtr == NULL) { tablePtr = &globalNsPtr->cmdTable; entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); } if (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, | | | 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 | if (entryPtr == NULL) { tablePtr = &globalNsPtr->cmdTable; entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern); } if (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } } } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) { /* * The pattern is non-trivial, but either there is no explicit path or |
︙ | ︙ | |||
762 763 764 765 766 767 768 | if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { | | | 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 | if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } entryPtr = Tcl_NextHashEntry(&search); } /* |
︙ | ︙ | |||
785 786 787 788 789 790 791 | entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, | | | 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 | entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } } entryPtr = Tcl_NextHashEntry(&search); } } } else { /* |
︙ | ︙ | |||
814 815 816 817 818 819 820 | Tcl_InitObjHashTable(&addedCommandsTable); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { | | | 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 | Tcl_InitObjHashTable(&addedCommandsTable); entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); } entryPtr = Tcl_NextHashEntry(&search); } |
︙ | ︙ | |||
840 841 842 843 844 845 846 | foundGlobal = 1; } entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { | | | 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 | foundGlobal = 1; } entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); (void) Tcl_CreateHashEntry(&addedCommandsTable, elemObjPtr, &isNew); if (isNew) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else { TclDecrRefCount(elemObjPtr); } |
︙ | ︙ | |||
867 868 869 870 871 872 873 | if (!foundGlobal) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { | | | 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 | if (!foundGlobal) { entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search); while (entryPtr != NULL) { cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); if (Tcl_FindHashEntry(&addedCommandsTable, (char *) elemObjPtr) == NULL) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else { TclDecrRefCount(elemObjPtr); } } |
︙ | ︙ | |||
1287 1288 1289 1290 1291 1292 1293 | switch (framePtr->type) { case TCL_LOCATION_EVAL: /* * Evaluation, dynamic script. Type, line, cmd, the latter through * str. */ | | | | 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 | switch (framePtr->type) { case TCL_LOCATION_EVAL: /* * Evaluation, dynamic script. Type, line, cmd, the latter through * str. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); if (framePtr->line) { ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0])); } else { ADD_PAIR("line", Tcl_NewWideIntObj(1)); } ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: /* * Precompiled. Result contains the type as signal, nothing else. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); break; case TCL_LOCATION_BC: { /* * Execution of bytecode. Talk to the BC engine to fill out the frame. */ |
︙ | ︙ | |||
1326 1327 1328 1329 1330 1331 1332 | TclGetSrcInfoForPc(fPtr); /* * Now filled: cmd.str.(cmd,len), line * Possibly modified: type, path! */ | | | 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 | TclGetSrcInfoForPc(fPtr); /* * Now filled: cmd.str.(cmd,len), line * Possibly modified: type, path! */ ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1)); if (fPtr->line) { ADD_PAIR("line", Tcl_NewWideIntObj(fPtr->line[0])); } if (fPtr->type == TCL_LOCATION_SOURCE) { ADD_PAIR("file", fPtr->data.eval.path); |
︙ | ︙ | |||
1354 1355 1356 1357 1358 1359 1360 | } case TCL_LOCATION_SOURCE: /* * Evaluation of a script file. */ | | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 | } case TCL_LOCATION_SOURCE: /* * Evaluation of a script file. */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0])); ADD_PAIR("file", framePtr->data.eval.path); /* * Refcount framePtr->data.eval.path goes up when lv is converted into * the result list object. */ |
︙ | ︙ | |||
1392 1393 1394 1395 1396 1397 1398 | TclNewObj(procNameObj); Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, procNameObj); ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; | | | | 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 | TclNewObj(procNameObj); Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, procNameObj); ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData; Tcl_Size i; /* * This is a non-standard command. Luckily, it's told us how to * render extra information about its frame. */ for (i=0 ; i<efiPtr->length ; i++) { lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); if (efiPtr->fields[i].proc) { lv[lc++] = efiPtr->fields[i].proc(efiPtr->fields[i].clientData); } else { lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData; } } |
︙ | ︙ | |||
1488 1489 1490 1491 1492 1493 1494 | " ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n" " ::set cmd [::namespace tail $cmd]\n" " ::if {$cmd ni $cmds} {\n" " ::lappend cmds $cmd\n" " }\n" " }\n" " ::return $cmds\n" | | | 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 | " ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n" " ::set cmd [::namespace tail $cmd]\n" " ::if {$cmd ni $cmds} {\n" " ::lappend cmds $cmd\n" " }\n" " }\n" " ::return $cmds\n" " } [::namespace current]] ", -1); if (objc == 2) { Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1])); Tcl_AppendObjToObj(script, arg); Tcl_DecrRefCount(arg); } |
︙ | ︙ | |||
1541 1542 1543 1544 1545 1546 1547 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } name = Tcl_GetHostName(); if (name) { | | | | 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } name = Tcl_GetHostName(); if (name) { Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to determine name of host", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1661 1662 1663 1664 1665 1666 1667 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { | | | | 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 | if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY); if (libDirName != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "no library has been specified for Tcl", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1793 1794 1795 1796 1797 1798 1799 | Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { | | | 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 | Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL, (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (patchlevel != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1)); return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
1906 1907 1908 1909 1910 1911 1912 | } else { simpleProcOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { | | | 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 | } else { simpleProcOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(simplePattern, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } } else #endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */ { |
︙ | ︙ | |||
1934 1935 1936 1937 1938 1939 1940 | } else { procOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { | | | 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 | } else { procOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(cmdName, -1); } Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } } entryPtr = Tcl_NextHashEntry(&search); } |
︙ | ︙ | |||
1973 1974 1975 1976 1977 1978 1979 | cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { Tcl_ListObjAppendElement(interp, listPtr, | | | 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 | cmdPtr = (Command *)Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) { Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(cmdName, -1)); } } } entryPtr = Tcl_NextHashEntry(&search); } } #endif |
︙ | ︙ | |||
2071 2072 2073 2074 2075 2076 2077 | { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } #ifdef TCL_SHLIB_EXT | | | 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 | { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return TCL_ERROR; } #ifdef TCL_SHLIB_EXT Tcl_SetObjResult(interp, Tcl_NewStringObj(TCL_SHLIB_EXT, -1)); #endif return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2168 2169 2170 2171 2172 2173 2174 | */ if (Tcl_IsSafe(interp) && (((Command *) command)->objProc == TclAliasObjCmd)) { Tcl_AppendResult(interp, "native", NULL); } else { Tcl_SetObjResult(interp, | | | 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 | */ if (Tcl_IsSafe(interp) && (((Command *) command)->objProc == TclAliasObjCmd)) { Tcl_AppendResult(interp, "native", NULL); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); } return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2197 2198 2199 2200 2201 2202 2203 | int Tcl_JoinObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { | | | 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 | int Tcl_JoinObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { Tcl_Size length, listLen; int isArithSeries = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?"); return TCL_ERROR; } |
︙ | ︙ | |||
2246 2247 2248 2249 2250 2251 2252 | joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { | | | 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 | joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { Tcl_Size i; resObjPtr = Tcl_NewObj(); if (isArithSeries) { Tcl_Obj *valueObj; for (i = 0; i < listLen; i++) { if (i > 0) { |
︙ | ︙ | |||
2321 2322 2323 2324 2325 2326 2327 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ | | | 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ Tcl_Size listObjc; /* The length of the list. */ int code = TCL_OK; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
2452 2453 2454 2455 2456 2457 2458 | Tcl_LinsertObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; | | | 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 | Tcl_LinsertObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; Tcl_Size len, index; int result; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
2475 2476 2477 2478 2479 2480 2481 | * appended to the list. */ result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index); if (result != TCL_OK) { return result; } | | | 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 | * appended to the list. */ result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index); if (result != TCL_OK) { return result; } if (index > len) { index = len; } /* * If the list object is unshared we can modify it directly. Otherwise we * create a copy to modify: this is "copy on write". */ |
︙ | ︙ | |||
2571 2572 2573 2574 2575 2576 2577 | Tcl_LlengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 | Tcl_LlengthObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int result; Tcl_Obj *objPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } |
︙ | ︙ | |||
2620 2621 2622 2623 2624 2625 2626 | Tcl_LpopObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 | Tcl_LpopObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size listLen; int result; Tcl_Obj *elemPtr, *stored; Tcl_Obj *listPtr, **elemPtrs; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?"); return TCL_ERROR; |
︙ | ︙ | |||
2649 2650 2651 2652 2653 2654 2655 | * TclLindexFlat adds a ref count which is handled. */ if (objc == 2) { if (!listLen) { /* empty list, throw the same error as with index "end" */ Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 | * TclLindexFlat adds a ref count which is handled. */ if (objc == 2) { if (!listLen) { /* empty list, throw the same error as with index "end" */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "index \"end\" out of range", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX" "OUTOFRANGE", NULL); return TCL_ERROR; } elemPtr = elemPtrs[listLen - 1]; Tcl_IncrRefCount(elemPtr); } else { |
︙ | ︙ | |||
2723 2724 2725 2726 2727 2728 2729 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; | | | 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Tcl_Size listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } result = TclListObjLengthM(interp, objv[1], &listLen); if (result != TCL_OK) { |
︙ | ︙ | |||
2782 2783 2784 2785 2786 2787 2788 | */ static int LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { | | | | | | 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 | */ static int LremoveIndexCompare( const void *el1Ptr, const void *el2Ptr) { Tcl_Size idx1 = *((const Tcl_Size *) el1Ptr); Tcl_Size idx2 = *((const Tcl_Size *) el2Ptr); /* * This will put the larger element first. */ return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0; } int Tcl_LremoveObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size i, idxc, prevIdx, first, num; Tcl_Size *idxv, listLen; Tcl_Obj *listObj; /* * Parse the arguments. */ if (objc < 2) { |
︙ | ︙ | |||
2822 2823 2824 2825 2826 2827 2828 | } idxc = objc - 2; if (idxc == 0) { Tcl_SetObjResult(interp, listObj); return TCL_OK; } | | | | | | 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 | } idxc = objc - 2; if (idxc == 0) { Tcl_SetObjResult(interp, listObj); return TCL_OK; } idxv = (Tcl_Size *)Tcl_Alloc((objc - 2) * sizeof(*idxv)); for (i = 2; i < objc; i++) { if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1, &idxv[i - 2]) != TCL_OK) { Tcl_Free(idxv); return TCL_ERROR; } } /* * Sort the indices, large to small so that when we remove an index we * don't change the indices still to be processed. */ if (idxc > 1) { qsort(idxv, idxc, sizeof(*idxv), LremoveIndexCompare); } /* * Make our working copy, then do the actual removes piecemeal. */ if (Tcl_IsShared(listObj)) { listObj = TclListObjCopy(NULL, listObj); } num = 0; first = listLen; for (i = 0, prevIdx = -1 ; i < idxc ; i++) { Tcl_Size idx = idxv[i]; /* * Repeated index and sanity check. */ if (idx == prevIdx) { continue; } prevIdx = idx; if (idx < 0 || idx >= listLen) { continue; } /* * Coalesce adjacent removes to reduce the number of copies. */ |
︙ | ︙ | |||
2951 2952 2953 2954 2955 2956 2957 | */ objc -= 2; objv += 2; /* Final sanity check. Do not exceed limits on max list length. */ | | | | 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 | */ objc -= 2; objv += 2; /* Final sanity check. Do not exceed limits on max list length. */ if (elementCount && objc > LIST_MAX/elementCount) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "max length of a Tcl list (%" TCL_SIZE_MODIFIER "d elements) exceeded", LIST_MAX)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } totalElems = objc * elementCount; /* * Get an empty list object that is allocated large enough to hold each |
︙ | ︙ | |||
3033 3034 3035 3036 3037 3038 3039 | Tcl_LreplaceObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; | | | 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 | Tcl_LreplaceObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; Tcl_Size numToDelete, listLen, first, last; int result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last ?element ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
3063 3064 3065 3066 3067 3068 3069 | } result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last); if (result != TCL_OK) { return result; } | | | | | 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 | } result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last); if (result != TCL_OK) { return result; } if (first < 0) { first = 0; } else if (first > listLen) { first = listLen; } if (last >= listLen) { last = listLen - 1; } if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; } /* * If the list object is unshared we can modify it directly, otherwise we |
︙ | ︙ | |||
3134 3135 3136 3137 3138 3139 3140 | Tcl_LreverseObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; | | | 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 | Tcl_LreverseObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; Tcl_Size elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } /* |
︙ | ︙ | |||
3240 3241 3242 3243 3244 3245 3246 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; int match, index, result=TCL_OK, bisect; | | | 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { const char *bytes, *patternBytes; int match, index, result=TCL_OK, bisect; Tcl_Size i, length = 0, listc, elemLen, start, groupSize, groupOffset, lower, upper; int allocatedIndexVector = 0; int isIncreasing; Tcl_WideInt patWide, objWide, wide; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; SortInfo sortInfo; Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; |
︙ | ︙ | |||
3299 3300 3301 3302 3303 3304 3305 | sortInfo.indexc = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern"); return TCL_ERROR; } | | | 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 | sortInfo.indexc = 0; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern"); return TCL_ERROR; } for (i = 1; i < objc-2; i++) { enum lsearchoptions idx; if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &idx) != TCL_OK) { result = TCL_ERROR; goto done; } switch (idx) { |
︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 | * because it will either be replaced or there will be an error. */ if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); startPtr = NULL; } | | | | | | | | | 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 | * because it will either be replaced or there will be an error. */ if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); startPtr = NULL; } if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing starting index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } i++; if (objv[i] == objv[objc - 2]) { /* * Take copy to prevent shimmering problems. Note that it does * not matter if the index obj is also a component of the list * being searched. We only need to copy where the list and the * index are one-and-the-same. */ startPtr = Tcl_DuplicateObj(objv[i]); } else { startPtr = objv[i]; } Tcl_IncrRefCount(startPtr); break; case LSEARCH_STRIDE: /* -stride */ if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-stride\" option must be " "followed by stride length", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { result = TCL_ERROR; goto done; } if (wide < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stride length must be at least 1", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE", NULL); result = TCL_ERROR; goto done; } groupSize = wide; i++; break; case LSEARCH_INDEX: { /* -index */ Tcl_Obj **indices; Tcl_Size j; if (allocatedIndexVector) { TclStackFree(interp, sortInfo.indexv); allocatedIndexVector = 0; } if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); result = TCL_ERROR; goto done; } |
︙ | ︙ | |||
3496 3497 3498 3499 3500 3501 3502 | /* * Subindices only make sense if asked for with -index option set. */ if (returnSubindices && sortInfo.indexc==0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 3496 3497 3498 3499 3500 3501 3502 3503 3504 3505 3506 3507 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 | /* * Subindices only make sense if asked for with -index option set. */ if (returnSubindices && sortInfo.indexc==0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "-subindices cannot be used without -index option", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); result = TCL_ERROR; goto done; } if (bisect && (allMatches || negatedMatch)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "-bisect is not compatible with -all or -not", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BAD_OPTION_MIX", NULL); result = TCL_ERROR; goto done; } if (mode == REGEXP) { |
︙ | ︙ | |||
3572 3573 3574 3575 3576 3577 3578 | if (sortInfo.indexc > 0) { /* * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); | | | | 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 | if (sortInfo.indexc > 0) { /* * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADINDEX", NULL); result = TCL_ERROR; goto done; } if (sortInfo.indexc == 1) { sortInfo.indexc = 0; |
︙ | ︙ | |||
3612 3613 3614 3615 3616 3617 3618 | } /* * If the search started past the end of the list, we just return a * "did not match anything at all" result straight away. [Bug 1374778] */ | | | 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 | } /* * If the search started past the end of the list, we just return a * "did not match anything at all" result straight away. [Bug 1374778] */ if (start >= listc) { if (allMatches || inlineReturn) { Tcl_ResetResult(interp); } else { TclNewIntObj(itemPtr, -1); Tcl_SetObjResult(interp, itemPtr); } goto done; |
︙ | ︙ | |||
3903 3904 3905 3906 3907 3908 3909 | Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, groupSize, &listv[i]); } else { itemPtr = listv[i]; Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { | | | 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 | Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, groupSize, &listv[i]); } else { itemPtr = listv[i]; Tcl_ListObjAppendElement(interp, listPtr, itemPtr); } } else if (returnSubindices) { Tcl_Size j; TclNewIndexObj(itemPtr, i+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc); TclNewIndexObj(elObj, elValue); Tcl_ListObjAppendElement(interp, itemPtr, elObj); |
︙ | ︙ | |||
3927 3928 3929 3930 3931 3932 3933 | * Return everything or a single value. */ if (allMatches) { Tcl_SetObjResult(interp, listPtr); } else if (!inlineReturn) { if (returnSubindices) { | | | 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 | * Return everything or a single value. */ if (allMatches) { Tcl_SetObjResult(interp, listPtr); } else if (!inlineReturn) { if (returnSubindices) { Tcl_Size j; TclNewIndexObj(itemPtr, index+groupOffset); for (j=0 ; j<sortInfo.indexc ; j++) { Tcl_Obj *elObj; size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc); TclNewIndexObj(elObj, elValue); Tcl_ListObjAppendElement(interp, itemPtr, elObj); |
︙ | ︙ | |||
4487 4488 4489 4490 4491 4492 4493 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int indices, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, allocatedIndexVector = 0; | | | | 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 4501 4502 4503 4504 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { int indices, nocase = 0, indexc; int sortMode = SORTMODE_ASCII; int group, allocatedIndexVector = 0; Tcl_Size j, idx, groupSize, groupOffset, length; Tcl_WideInt wide; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; Tcl_Size i, elmArrSize; SortElement *elementArray = NULL, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ # define MAXCALLOC 1024000 # define NUM_LISTS 30 SortElement *subList[NUM_LISTS+1]; /* This array holds pointers to temporary |
︙ | ︙ | |||
4534 4535 4536 4537 4538 4539 4540 | sortInfo.resultCode = TCL_OK; cmdPtr = NULL; indices = 0; group = 0; groupSize = 1; groupOffset = 0; indexPtr = NULL; | | | | | | | 4534 4535 4536 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 4572 4573 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 | sortInfo.resultCode = TCL_OK; cmdPtr = NULL; indices = 0; group = 0; groupSize = 1; groupOffset = 0; indexPtr = NULL; for (i = 1; i < objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } switch (index) { case LSORT_ASCII: sortInfo.sortMode = SORTMODE_ASCII; break; case LSORT_COMMAND: if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-command\" option must be followed " "by comparison command", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } sortInfo.sortMode = SORTMODE_COMMAND; cmdPtr = objv[i+1]; i++; break; case LSORT_DECREASING: sortInfo.isIncreasing = 0; break; case LSORT_DICTIONARY: sortInfo.sortMode = SORTMODE_DICTIONARY; break; case LSORT_INCREASING: sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { Tcl_Size sortindex; Tcl_Obj **indexv; if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } |
︙ | ︙ | |||
4632 4633 4634 4635 4636 4637 4638 | case LSORT_UNIQUE: sortInfo.unique = 1; break; case LSORT_INDICES: indices = 1; break; case LSORT_STRIDE: | | | | | 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 4644 4645 4646 4647 4648 4649 4650 4651 4652 4653 4654 4655 4656 4657 4658 4659 4660 | case LSORT_UNIQUE: sortInfo.unique = 1; break; case LSORT_INDICES: indices = 1; break; case LSORT_STRIDE: if (i == objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-stride\" option must be " "followed by stride length", -1)); Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done; } if (wide < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "stride length must be at least 2", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } groupSize = wide; group = 1; |
︙ | ︙ | |||
4765 4766 4767 4768 4769 4770 4771 | if (sortInfo.indexc > 0) { /* * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); | | | | 4765 4766 4767 4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 | if (sortInfo.indexc > 0) { /* * Use the first value in the list supplied to -index as the * offset of the element within each group by which to sort. */ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1); if (groupOffset < 0 || groupOffset >= groupSize) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "when used with \"-stride\", the leading \"-index\"" " value must be within the group", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADINDEX", NULL); sortInfo.resultCode = TCL_ERROR; goto done; } if (sortInfo.indexc == 1) { sortInfo.indexc = 0; |
︙ | ︙ | |||
5009 5010 5011 5012 5013 5014 5015 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ int createdNewObj; int result; | | | | | | 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 5024 5025 5026 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ int createdNewObj; int result; Tcl_Size first; Tcl_Size last; Tcl_Size listLen; Tcl_Size numToDelete; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, "listVar first last ?element ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
5045 5046 5047 5048 5049 5050 5051 | } result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last); if (result != TCL_OK) { return result; } | | | | | 5045 5046 5047 5048 5049 5050 5051 5052 5053 5054 5055 5056 5057 5058 5059 5060 5061 5062 5063 5064 5065 5066 5067 5068 5069 | } result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last); if (result != TCL_OK) { return result; } if (first < 0) { first = 0; } else if (first > listLen) { first = listLen; } /* The +1 in comparisons are necessitated by indices being unsigned */ if (last >= listLen) { last = listLen - 1; } if (first <= last) { numToDelete = last - first + 1; } else { numToDelete = 0; } if (Tcl_IsShared(listPtr)) { listPtr = TclListObjCopy(NULL, listPtr); |
︙ | ︙ | |||
5251 5252 5253 5254 5255 5256 5257 | double a, b; a = elemPtr1->collationKey.doubleValue; b = elemPtr2->collationKey.doubleValue; order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; | | | 5251 5252 5253 5254 5255 5256 5257 5258 5259 5260 5261 5262 5263 5264 5265 | double a, b; a = elemPtr1->collationKey.doubleValue; b = elemPtr2->collationKey.doubleValue; order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; Tcl_Size objc; Tcl_Obj *objPtr1, *objPtr2; if (infoPtr->resultCode != TCL_OK) { /* * Once an error has occurred, skip any future comparisons so as * to preserve the error message in sortInterp->result. */ |
︙ | ︙ | |||
5295 5296 5297 5298 5299 5300 5301 | /* * Parse the result of the command. */ if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( | | | 5295 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 | /* * Parse the result of the command. */ if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( "-compare command returned non-integer result", -1)); Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return 0; } } if (!infoPtr->isIncreasing) { |
︙ | ︙ | |||
5469 5470 5471 5472 5473 5474 5475 | static Tcl_Obj * SelectObjFromSublist( Tcl_Obj *objPtr, /* Obj to select sublist from. */ SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { | | | | | 5469 5470 5471 5472 5473 5474 5475 5476 5477 5478 5479 5480 5481 5482 5483 5484 5485 5486 5487 5488 5489 5490 5491 5492 5493 5494 5495 5496 5497 5498 5499 5500 5501 5502 5503 5504 5505 5506 5507 5508 5509 5510 5511 5512 5513 5514 5515 5516 | static Tcl_Obj * SelectObjFromSublist( Tcl_Obj *objPtr, /* Obj to select sublist from. */ SortInfo *infoPtr) /* Information passed from the top-level * "lsearch" or "lsort" command. */ { Tcl_Size i; /* * Quick check for case when no "-index" option is there. */ if (infoPtr->indexc == 0) { return objPtr; } /* * Iterate over the indices, traversing through the nested sublists as we * go. */ for (i=0 ; i<infoPtr->indexc ; i++) { Tcl_Size listLen; int index; Tcl_Obj *currentObj; if (TclListObjLengthM(infoPtr->interp, objPtr, &listLen) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } index = TclIndexDecode(infoPtr->indexv[i], listLen - 1); if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index, ¤tObj) != TCL_OK) { infoPtr->resultCode = TCL_ERROR; return NULL; } if (currentObj == NULL) { if (index == TCL_INDEX_NONE) { index = TCL_INDEX_END - infoPtr->indexv[i]; Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element end-%d missing from sublist \"%s\"", index, TclGetString(objPtr))); } else { Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( "element %d missing from sublist \"%s\"", |
︙ | ︙ |
Changes to generic/tclCmdMZ.c.
︙ | ︙ | |||
124 125 126 127 128 129 130 | int Tcl_RegexpObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 | int Tcl_RegexpObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size offset, stringLength, matchLength, cflags, eflags; int i, indices, match, about, all, doinline, numMatchesSaved; Tcl_RegExp regExpr; Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL; Tcl_RegExpInfo info; static const char *const options[] = { "-all", "-about", "-indices", "-inline", "-expanded", "-line", "-linestop", "-lineanchor", |
︙ | ︙ | |||
187 188 189 190 191 192 193 | case REGEXP_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGEXP_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { | | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 | case REGEXP_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGEXP_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGEXP_START: { Tcl_Size temp; if (++i >= objc) { goto endOfForLoop; } if (TclGetIntForIndexM(interp, objv[i], TCL_SIZE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } startIndex = objv[i]; Tcl_IncrRefCount(startIndex); |
︙ | ︙ | |||
223 224 225 226 227 228 229 | /* * Check if the user requested -inline, but specified match variables; a * no-no. */ if (doinline && ((objc - 2) != 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | /* * Check if the user requested -inline, but specified match variables; a * no-no. */ if (doinline && ((objc - 2) != 0)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "regexp match variables not allowed when using -inline", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP", "MIX_VAR_INLINE", NULL); goto optionError; } /* * Handle the odd about case separately. |
︙ | ︙ | |||
257 258 259 260 261 262 263 | objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); if (startIndex) { TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); | | | 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 | objPtr = objv[1]; stringLength = Tcl_GetCharLength(objPtr); if (startIndex) { TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); if (offset < 0) { offset = TCL_INDEX_START; } } regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if (regExpr == NULL) { return TCL_ERROR; |
︙ | ︙ | |||
304 305 306 307 308 309 310 | * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ if (offset == TCL_INDEX_START) { eflags = 0; | | | 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 | * considered the start of the line. If for example the pattern {^} is * passed and -start is positive, then the pattern will not match the * start of the string unless the previous character is a newline. */ if (offset == TCL_INDEX_START) { eflags = 0; } else if (offset > stringLength) { eflags = TCL_REG_NOTBOL; } else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') { eflags = 0; } else { eflags = TCL_REG_NOTBOL; } |
︙ | ︙ | |||
360 361 362 363 364 365 366 | resultPtr = Tcl_NewObj(); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { | | | | | | 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | resultPtr = Tcl_NewObj(); } } for (i = 0; i < objc; i++) { Tcl_Obj *newPtr; if (indices) { Tcl_Size start, end; Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for that * area. (Scriptics Bug 4391/SF Bug #219232) */ if (i <= (int)info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the * match instead of the first character after the match. */ if (end >= offset) { end--; } } else { start = TCL_INDEX_NONE; end = TCL_INDEX_NONE; } TclNewIndexObj(objs[0], start); TclNewIndexObj(objs[1], end); newPtr = Tcl_NewListObj(2, objs); } else { if ((i <= (int)info.nsubs) && (info.matches[i].end > 0)) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); } else { newPtr = Tcl_NewObj(); } } |
︙ | ︙ | |||
440 441 442 443 444 445 446 | * these cases we always want to bump the index up one. */ if (matchLength == 0) { offset++; } all++; | | | 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 | * these cases we always want to bump the index up one. */ if (matchLength == 0) { offset++; } all++; if (offset >= stringLength) { break; } } /* * Set the interpreter's object result to an integer object with value 1 * if -all wasn't specified, otherwise it's all-1 (the number of times |
︙ | ︙ | |||
484 485 486 487 488 489 490 | Tcl_RegsubObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result, cflags, all, match, command; | | | | 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 | Tcl_RegsubObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result, cflags, all, match, command; Tcl_Size idx, wlen, wsublen = 0, offset, numMatches, numParts; Tcl_Size start, end, subStart, subEnd; Tcl_RegExp regExpr; Tcl_RegExpInfo info; Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL; Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend; static const char *const options[] = { "-all", "-command", "-expanded", "-line", |
︙ | ︙ | |||
508 509 510 511 512 513 514 | cflags = TCL_REG_ADVANCED; all = 0; offset = TCL_INDEX_START; command = 0; resultPtr = NULL; | | | 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 | cflags = TCL_REG_ADVANCED; all = 0; offset = TCL_INDEX_START; command = 0; resultPtr = NULL; for (idx = 1; idx < objc; idx++) { const char *name; name = TclGetString(objv[idx]); if (name[0] != '-') { break; } if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option", |
︙ | ︙ | |||
542 543 544 545 546 547 548 | case REGSUB_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { | | | | | | | | | | | 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 | case REGSUB_LINESTOP: cflags |= TCL_REG_NLSTOP; break; case REGSUB_LINEANCHOR: cflags |= TCL_REG_NLANCH; break; case REGSUB_START: { Tcl_Size temp; if (++idx >= objc) { goto endOfForLoop; } if (TclGetIntForIndexM(interp, objv[idx], TCL_SIZE_MAX - 1, &temp) != TCL_OK) { goto optionError; } if (startIndex) { Tcl_DecrRefCount(startIndex); } startIndex = objv[idx]; Tcl_IncrRefCount(startIndex); break; } case REGSUB_LAST: idx++; goto endOfForLoop; } } endOfForLoop: if (objc < idx + 3 || objc > idx + 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? exp string subSpec ?varName?"); optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); } return TCL_ERROR; } objc -= idx; objv += idx; if (startIndex) { Tcl_Size stringLength = Tcl_GetCharLength(objv[1]); TclGetIntForIndexM(interp, startIndex, stringLength, &offset); Tcl_DecrRefCount(startIndex); if (offset < 0) { offset = 0; } } if (all && (offset == 0) && (command == 0) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* * This is a simple one pair string map situation. We make use of a * slightly modified version of the one pair STR_MAP code. */ Tcl_Size slen; int nocase, wsrclc; int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t); Tcl_UniChar *p; numMatches = 0; nocase = (cflags & TCL_REG_NOCASE); strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp; |
︙ | ︙ | |||
770 771 772 773 774 775 776 | * arguments to the subSpec to form a command, that is then executed * and the result used as the string to substitute in. Actually, * everything is passed through Tcl_EvalObjv, as that's much faster. */ if (command) { Tcl_Obj **args = NULL, **parts; | | | | 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 | * arguments to the subSpec to form a command, that is then executed * and the result used as the string to substitute in. Actually, * everything is passed through Tcl_EvalObjv, as that's much faster. */ if (command) { Tcl_Obj **args = NULL, **parts; Tcl_Size numArgs; TclListObjGetElementsM(interp, subPtr, &numParts, &parts); numArgs = numParts + info.nsubs + 1; args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs); memcpy(args, parts, sizeof(Tcl_Obj*) * numParts); for (idx = 0 ; idx <= info.nsubs ; idx++) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { args[idx + numParts] = Tcl_NewUnicodeObj( wstring + offset + subStart, subEnd - subStart); } else { args[idx + numParts] = Tcl_NewObj(); } Tcl_IncrRefCount(args[idx + numParts]); } |
︙ | ︙ | |||
884 885 886 887 888 889 890 | Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; | | | 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 | Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar); } if (idx <= info.nsubs) { subStart = info.matches[idx].start; subEnd = info.matches[idx].end; if ((subStart >= 0) && (subEnd >= 0)) { Tcl_AppendUnicodeToObj(resultPtr, wstring + offset + subStart, subEnd - subStart); } } if (*wsrc == '\\') { wsrc++; |
︙ | ︙ | |||
1175 1176 1177 1178 1179 1180 1181 | Tcl_Obj *const objv[]) /* Argument objects. */ { int ch = 0; int len; const char *splitChars; const char *stringPtr; const char *end; | | | 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 | Tcl_Obj *const objv[]) /* Argument objects. */ { int ch = 0; int len; const char *splitChars; const char *stringPtr; const char *end; Tcl_Size splitCharLen, stringLen; Tcl_Obj *listPtr, *objPtr; if (objc == 2) { splitChars = " \n\t\r"; splitCharLen = 4; } else if (objc == 3) { splitChars = Tcl_GetStringFromObj(objv[2], &splitCharLen); |
︙ | ︙ | |||
1248 1249 1250 1251 1252 1253 1254 | Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; | | | 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 | Tcl_ListObjAppendElement(NULL, listPtr, objPtr); stringPtr = p + 1; } TclNewStringObj(objPtr, stringPtr, end - stringPtr); Tcl_ListObjAppendElement(NULL, listPtr, objPtr); } else { const char *element, *p, *splitEnd; Tcl_Size splitLen; int splitChar; /* * Normal case: split on any of a given set of characters. Discard * instances of the split characters. */ |
︙ | ︙ | |||
1303 1304 1305 1306 1307 1308 1309 | static int StringFirstCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 | static int StringFirstCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size start = TCL_INDEX_START; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?startIndex?"); return TCL_ERROR; } if (objc == 4) { Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1; if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) { return TCL_ERROR; } } Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start)); return TCL_OK; |
︙ | ︙ | |||
1347 1348 1349 1350 1351 1352 1353 | static int StringLastCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 | static int StringLastCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size last = TCL_SIZE_MAX; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "needleString haystackString ?lastIndex?"); return TCL_ERROR; } if (objc == 4) { Tcl_Size end = Tcl_GetCharLength(objv[2]) - 1; if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) { return TCL_ERROR; } } Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last)); return TCL_OK; |
︙ | ︙ | |||
1391 1392 1393 1394 1395 1396 1397 | static int StringIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 | static int StringIndexCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size index, end; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string charIndex"); return TCL_ERROR; } /* * Get the char length to calculate what 'end' means. */ end = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) { return TCL_ERROR; } if ((index >= 0) && (index <= end)) { int ch = Tcl_GetUniChar(objv[1], index); if (ch == -1) { return TCL_OK; } /* |
︙ | ︙ | |||
1463 1464 1465 1466 1467 1468 1469 | static int StringInsertCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { | | | | | 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | static int StringInsertCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[]) /* Argument objects */ { Tcl_Size length; /* String length */ Tcl_Size index; /* Insert index */ Tcl_Obj *outObj; /* Output object */ if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string index insertString"); return TCL_ERROR; } length = Tcl_GetCharLength(objv[1]); if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) { return TCL_ERROR; } if (index < 0) { index = TCL_INDEX_START; } if (index > length) { index = length; } outObj = TclStringReplace(interp, objv[1], index, 0, objv[3], |
︙ | ︙ | |||
1523 1524 1525 1526 1527 1528 1529 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *end, *stop; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, result = 1, strict = 0; | | | 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *end, *stop; int (*chcomp)(int) = NULL; /* The UniChar comparison function. */ int i, result = 1, strict = 0; Tcl_Size failat = 0, length1, length2, length3; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; static const char *const isClasses[] = { "alnum", "alpha", "ascii", "control", "boolean", "dict", "digit", "double", "entier", "false", "graph", "integer", |
︙ | ︙ | |||
1626 1627 1628 1629 1630 1631 1632 | } break; case STR_IS_CONTROL: chcomp = Tcl_UniCharIsControl; break; case STR_IS_DICT: { int dresult; | | | < | 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 | } break; case STR_IS_CONTROL: chcomp = Tcl_UniCharIsControl; break; case STR_IS_DICT: { int dresult; Tcl_Size dsize; dresult = Tcl_DictObjSize(interp, objPtr, &dsize); Tcl_ResetResult(interp); result = (dresult == TCL_OK) ? 1 : 0; if (dresult != TCL_OK && failVarObj != NULL) { /* * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetDictFromAny(). */ const char *elemStart, *nextElem; Tcl_Size lenRemain, elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { |
︙ | ︙ | |||
1820 1821 1822 1823 1824 1825 1826 | /* * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; | | | | 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 | /* * Need to figure out where the list parsing failed, which is * fairly expensive. This is adapted from the core of * SetListFromAny(). */ const char *elemStart, *nextElem; Tcl_Size lenRemain; Tcl_Size elemSize; const char *p; string1 = Tcl_GetStringFromObj(objPtr, &length1); end = string1 + length1; failat = -1; for (p=string1, lenRemain=length1; lenRemain > 0; p=nextElem, lenRemain=end-nextElem) { |
︙ | ︙ | |||
1956 1957 1958 1959 1960 1961 1962 | static int StringMapCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 | static int StringMapCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size length1, length2, mapElemc, index; int nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t); if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string"); |
︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 | /* * This test is tricky, but has to be that way or you get other strange * inconsistencies (see test string-10.20.1 for illustration why!) */ if (!TclHasStringRep(objv[objc-2]) && TclHasInternalRep(objv[objc-2], &tclDictType)) { | | | 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 | /* * This test is tricky, but has to be that way or you get other strange * inconsistencies (see test string-10.20.1 for illustration why!) */ if (!TclHasStringRep(objv[objc-2]) && TclHasInternalRep(objv[objc-2], &tclDictType)) { Tcl_Size i; int done; Tcl_DictSearch search; /* * We know the type exactly, so all dict operations will succeed for * sure. This shortens this code quite a bit. */ |
︙ | ︙ | |||
2024 2025 2026 2027 2028 2029 2030 | Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); for (index=2 ; index<mapElemc ; index+=2) { Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done); } Tcl_DictObjDone(&search); } else { | | | | 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 | Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0, mapElemv+1, &done); for (index=2 ; index<mapElemc ; index+=2) { Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done); } Tcl_DictObjDone(&search); } else { Tcl_Size i; if (TclListObjGetElementsM(interp, objv[objc-2], &i, &mapElemv) != TCL_OK) { return TCL_ERROR; } mapElemc = i; if (mapElemc == 0) { /* * empty charMap, just return whatever string was given. */ Tcl_SetObjResult(interp, objv[objc-1]); return TCL_OK; } else if (mapElemc & 1) { /* * The charMap must be an even number of key/value items. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("char map list unbalanced", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP", "UNBALANCED", NULL); return TCL_ERROR; } } /* |
︙ | ︙ | |||
2087 2088 2089 2090 2091 2092 2093 | /* * Special case for one map pair which avoids the extra for loop and * extra calls to get Unicode data. The algorithm is otherwise * identical to the multi-pair case. This will be >30% faster on * larger strings. */ | | | 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 | /* * Special case for one map pair which avoids the extra for loop and * extra calls to get Unicode data. The algorithm is otherwise * identical to the multi-pair case. This will be >30% faster on * larger strings. */ Tcl_Size mapLen; int u2lc; Tcl_UniChar *mapString; ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2); p = ustring1; if ((length2 > length1) || (length2 == 0)) { /* |
︙ | ︙ | |||
2121 2122 2123 2124 2125 2126 2127 | Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings; | | | | 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 | Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen); } } } } else { Tcl_UniChar **mapStrings; Tcl_Size *mapLens; int *u2lc = 0; /* * Precompute pointers to the Unicode string and length. This saves us * repeated function calls later, significantly speeding up the * algorithm. We only need the lowercase first char in the nocase * case. */ mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2); mapLens = (Tcl_Size *)TclStackAlloc(interp, mapElemc * sizeof(Tcl_Size) * 2); if (nocase) { u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int)); } for (index = 0; index < mapElemc; index++) { mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index], mapLens+index); if (nocase && ((index % 2) == 0)) { |
︙ | ︙ | |||
2154 2155 2156 2157 2158 2159 2160 | */ ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ | | | 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 | */ ustring2 = mapStrings[index]; length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && /* Restrict max compare length. */ ((end-ustring1) >= length2) && ((length2 == 1) || !strCmpFn(ustring2, ustring1, length2))) { if (p != ustring1) { /* * Put the skipped chars onto the result first. */ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p); |
︙ | ︙ | |||
2240 2241 2242 2243 2244 2245 2246 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { | | | 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 | if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string"); return TCL_ERROR; } if (objc == 4) { Tcl_Size length; const char *string = Tcl_GetStringFromObj(objv[1], &length); if ((length > 1) && strncmp(string, "-nocase", length) == 0) { nocase = TCL_MATCH_NOCASE; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( |
︙ | ︙ | |||
2284 2285 2286 2287 2288 2289 2290 | static int StringRangeCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 | static int StringRangeCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size first, last, end; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "string first last"); return TCL_ERROR; } /* * Get the length in actual characters; Then reduce it by one because * 'end' refers to the last character, not one past it. */ end = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { return TCL_ERROR; } if (last >= 0) { Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last)); } return TCL_OK; } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
2390 2391 2392 2393 2394 2395 2396 | static int StringRplcCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | | | | 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 | static int StringRplcCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size first, last, end; if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?"); return TCL_ERROR; } end = Tcl_GetCharLength(objv[1]) - 1; if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK || TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) { return TCL_ERROR; } /* * The following test screens out most empty substrings as candidates for * replacement. When they are detected, no replacement is done, and the * result is the original string. */ if ((last < 0) || /* Range ends before start of string */ (first > end) || /* Range begins after end of string */ (last < first)) { /* Range begins after it starts */ /* * BUT!!! when (end < 0) -- an empty original string -- we can * have (first <= end < 0 <= last) and an empty string is permitted * to be replaced. */ Tcl_SetObjResult(interp, objv[1]); } else { Tcl_Obj *resultPtr; if (first < 0) { first = TCL_INDEX_START; } if (last > end) { last = end; } resultPtr = TclStringReplace(interp, objv[1], first, last + 1 - first, (objc == 5) ? objv[4] : NULL, TCL_STRING_IN_PLACE); |
︙ | ︙ | |||
2502 2503 2504 2505 2506 2507 2508 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *string; | | | | | 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *string; Tcl_Size cur, index, length; Tcl_Obj *obj; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } if (index >= length) { index = length - 1; } cur = 0; if (index > 0) { p = &string[index]; (void)TclUniCharToUCS4(p, &ch); for (cur = index; cur != TCL_INDEX_NONE; cur--) { int delta = 0; const Tcl_UniChar *next; |
︙ | ︙ | |||
2572 2573 2574 2575 2576 2577 2578 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *end, *string; | | | | | | 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int ch; const Tcl_UniChar *p, *end, *string; Tcl_Size cur, index, length; Tcl_Obj *obj; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "string index"); return TCL_ERROR; } string = Tcl_GetUnicodeFromObj(objv[1], &length); if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) { return TCL_ERROR; } if (index < 0) { index = 0; } if (index < length) { p = &string[index]; end = string+length; for (cur = index; p < end; cur++) { p += TclUniCharToUCS4(p, &ch); if (!Tcl_UniCharIsWordChar(ch)) { break; } |
︙ | ︙ | |||
2640 2641 2642 2643 2644 2645 2646 | * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ const char *string2; int i, match, nocase = 0, reqlength = -1; | | | 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 | * Remember to keep code here in some sync with the byte-compiled versions * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...). */ const char *string2; int i, match, nocase = 0, reqlength = -1; Tcl_Size length; if (objc < 3 || objc > 6) { str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? ?-length int? string1 string2"); return TCL_ERROR; } |
︙ | ︙ | |||
2736 2737 2738 2739 2740 2741 2742 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength) { int i; | | | 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[], /* Argument objects. */ int *nocase, int *reqlength) { int i; Tcl_Size length; const char *string; *reqlength = -1; *nocase = 0; if (objc < 3 || objc > 6) { str_cmp_args: Tcl_WrongNumArgs(interp, 1, objv, |
︙ | ︙ | |||
2876 2877 2878 2879 2880 2881 2882 | static int StringLowerCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | | | | 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 | static int StringLowerCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToLower(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToLower(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* |
︙ | ︙ | |||
2961 2962 2963 2964 2965 2966 2967 | static int StringUpperCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | | | | | 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 | static int StringUpperCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToUpper(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToUpper(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* |
︙ | ︙ | |||
3046 3047 3048 3049 3050 3051 3052 | static int StringTitleCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | | | | | | | 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 | static int StringTitleCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Size length1, length2; const char *string1; char *string2; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?"); return TCL_ERROR; } string1 = Tcl_GetStringFromObj(objv[1], &length1); if (objc == 2) { Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1); length1 = Tcl_UtfToTitle(TclGetString(resultPtr)); Tcl_SetObjLength(resultPtr, length1); Tcl_SetObjResult(interp, resultPtr); } else { Tcl_Size first, last; const char *start, *end; Tcl_Obj *resultPtr; length1 = Tcl_NumUtfChars(string1, length1) - 1; if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) { return TCL_ERROR; } if (first < 0) { first = 0; } last = first; if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1, &last) != TCL_OK)) { return TCL_ERROR; } if (last >= length1) { last = length1; } if (last < first) { Tcl_SetObjResult(interp, objv[1]); return TCL_OK; } string1 = Tcl_GetStringFromObj(objv[1], &length1); start = Tcl_UtfAtIndex(string1, first); end = Tcl_UtfAtIndex(start, last - first + 1); resultPtr = Tcl_NewStringObj(string1, end - string1); string2 = TclGetString(resultPtr) + (start - string1); length2 = Tcl_UtfToTitle(string2); Tcl_SetObjLength(resultPtr, length2 + (start - string1)); Tcl_AppendToObj(resultPtr, end, -1); Tcl_SetObjResult(interp, resultPtr); } return TCL_OK; } /* |
︙ | ︙ | |||
3132 3133 3134 3135 3136 3137 3138 | StringTrimCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; | | | 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 | StringTrimCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; Tcl_Size triml, trimr, length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { |
︙ | ︙ | |||
3180 3181 3182 3183 3184 3185 3186 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; | | | 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; Tcl_Size length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { |
︙ | ︙ | |||
3227 3228 3229 3230 3231 3232 3233 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; | | | 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { const char *string1, *string2; int trim; Tcl_Size length1, length2; if (objc == 3) { string2 = Tcl_GetStringFromObj(objv[2], &length2); } else if (objc == 2) { string2 = tclDefaultTrimSet; length2 = strlen(tclDefaultTrimSet); } else { |
︙ | ︙ | |||
3324 3325 3326 3327 3328 3329 3330 | * *---------------------------------------------------------------------- */ int TclSubstOptions( Tcl_Interp *interp, | | < | 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 | * *---------------------------------------------------------------------- */ int TclSubstOptions( Tcl_Interp *interp, Tcl_Size numOpts, Tcl_Obj *const opts[], int *flagPtr) { static const char *const substOptions[] = { "-nobackslashes", "-nocommands", "-novariables", NULL }; enum { SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS }; int i, flags = TCL_SUBST_ALL; for (i = 0; i < numOpts; i++) { int optionIndex; if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0, &optionIndex) != TCL_OK) { return TCL_ERROR; |
︙ | ︙ | |||
3428 3429 3430 3431 3432 3433 3434 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, mode, foundmode, splitObjs, numMatchesSaved; int noCase; | | | 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int i, mode, foundmode, splitObjs, numMatchesSaved; int noCase; Tcl_Size patternLength, j; const char *pattern; Tcl_Obj *stringObj, *indexVarObj, *matchVarObj; Tcl_Obj *const *savedObjv = objv; Tcl_RegExp regExpr = NULL; Interp *iPtr = (Interp *) interp; int pc = 0; int bidx = 0; /* Index of body argument. */ |
︙ | ︙ | |||
3576 3577 3578 3579 3580 3581 3582 | * the same data for the list word itself. The cmdFramePtr line * information is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; | | | 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 | * the same data for the list word itself. The cmdFramePtr line * information is manipulated directly. */ splitObjs = 0; if (objc == 1) { Tcl_Obj **listv; Tcl_Size listc; blist = objv[0]; if (TclListObjLengthM(interp, objv[0], &listc) != TCL_OK) { return TCL_ERROR; } /* |
︙ | ︙ | |||
3608 3609 3610 3611 3612 3613 3614 | * Complain if there is an odd number of words in the list of patterns and * bodies. */ if (objc % 2) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 | * Complain if there is an odd number of words in the list of patterns and * bodies. */ if (objc % 2) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj( "extra switch pattern with no body", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", NULL); /* * Check if this can be due to a badly placed comment in the switch * block. * * The following is an heuristic to detect the infamous "comment in * switch" error: just check if a pattern begins with '#'. */ if (splitObjs) { for (i=0 ; i<objc ; i+=2) { if (TclGetString(objv[i])[0] == '#') { Tcl_AppendToObj(Tcl_GetObjResult(interp), ", this may be due to a comment incorrectly" " placed outside of a switch body - see the" " \"switch\" documentation", -1); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM", "COMMENT?", NULL); break; } } } |
︙ | ︙ | |||
3744 3745 3746 3747 3748 3749 3750 | TclNewObj(indicesObj); } for (j=0 ; j<=info.nsubs ; j++) { if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; | | | | 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 | TclNewObj(indicesObj); } for (j=0 ; j<=info.nsubs ; j++) { if (indexVarObj != NULL) { Tcl_Obj *rangeObjAry[2]; if (info.matches[j].end > 0) { TclNewIndexObj(rangeObjAry[0], info.matches[j].start); TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1); } else { TclNewIntObj(rangeObjAry[1], -1); rangeObjAry[0] = rangeObjAry[1]; } /* * Never fails; the object is always clean at this point. */ Tcl_ListObjAppendElement(NULL, indicesObj, Tcl_NewListObj(2, rangeObjAry)); } if (matchVarObj != NULL) { Tcl_Obj *substringObj; if (info.matches[j].end > 0) { substringObj = Tcl_GetRange(stringObj, info.matches[j].start, info.matches[j].end-1); } else { TclNewObj(substringObj); } /* |
︙ | ︙ | |||
3868 3869 3870 3871 3872 3873 3874 | for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { | | | 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 | for (k=0; k < objc; k++) { ctxPtr->line[k] = -1; } } } for (j = i + 1; ; j += 2) { if (j >= objc) { /* * This shouldn't happen since we've checked that the last body is * not a continuation... */ Tcl_Panic("fall-out when searching for body to match pattern"); } |
︙ | ︙ | |||
3902 3903 3904 3905 3906 3907 3908 | { /* Unpack the preserved data */ int splitObjs = PTR2INT(data[0]); CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); const char *pattern = (const char *)data[3]; | | | 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 | { /* Unpack the preserved data */ int splitObjs = PTR2INT(data[0]); CmdFrame *ctxPtr = (CmdFrame *)data[1]; int pc = PTR2INT(data[2]); const char *pattern = (const char *)data[3]; Tcl_Size patternLength = strlen(pattern); /* * Clean up TIP 280 context information */ if (splitObjs) { Tcl_Free(ctxPtr->line); |
︙ | ︙ | |||
3924 3925 3926 3927 3928 3929 3930 | } /* * Generate an error message if necessary. */ if (result == TCL_ERROR) { | | | | 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 | } /* * Generate an error message if necessary. */ if (result == TCL_ERROR) { int limit = 50; int overflow = (patternLength > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (\"%.*s%s\" arm line %d)", (int) (overflow ? limit : patternLength), pattern, (overflow ? "..." : ""), Tcl_GetErrorLine(interp))); } TclStackFree(interp, ctxPtr); return result; } /* |
︙ | ︙ | |||
3961 3962 3963 3964 3965 3966 3967 | Tcl_ThrowObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; | | | | 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 3971 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 | Tcl_ThrowObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *options; Tcl_Size len; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "type message"); return TCL_ERROR; } /* * The type must be a list of at least length 1. */ if (TclListObjLengthM(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "type must be non-empty list", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION", NULL); return TCL_ERROR; } /* * Now prepare the result options dictionary. We use the list API as it is |
︙ | ︙ | |||
4678 4679 4680 4681 4682 4683 4684 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; int i, bodyShared, haveHandlers, code; | | | 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL; int i, bodyShared, haveHandlers, code; Tcl_Size dummy; static const char *const handlerNames[] = { "finally", "on", "trap", NULL }; enum Handlers { TryFinally, TryOn, TryTrap }; |
︙ | ︙ | |||
4714 4715 4716 4717 4718 4719 4720 | Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } switch (type) { case TryFinally: /* finally script */ if (i < objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | | 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 | Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } switch (type) { case TryFinally: /* finally script */ if (i < objc-2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "finally clause must be last", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "NONTERMINAL", NULL); return TCL_ERROR; } else if (i == objc-1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to finally clause: must be" " \"... finally script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY", "ARGUMENT", NULL); return TCL_ERROR; } finallyObj = objv[++i]; break; case TryOn: /* on code variableList script */ if (i > objc-4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "wrong # args to on clause: must be \"... on code" " variableList script\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON", "ARGUMENT", NULL); return TCL_ERROR; } if (TclGetCompletionCodeFromObj(interp, objv[i+1], &code) != TCL_OK) { |
︙ | ︙ | |||
4796 4797 4798 4799 4800 4801 4802 | haveHandlers = 1; i += 3; break; } } if (bodyShared) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 | haveHandlers = 1; i += 3; break; } } if (bodyShared) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "last non-finally clause must not have a body of \"-\"", -1)); Tcl_DecrRefCount(handlersObj); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH", NULL); return TCL_ERROR; } if (!haveHandlers) { Tcl_DecrRefCount(handlersObj); |
︙ | ︙ | |||
4876 4877 4878 4879 4880 4881 4882 | TryPostBody( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; int code, objc; | | | 4874 4875 4876 4877 4878 4879 4880 4881 4882 4883 4884 4885 4886 4887 4888 | TryPostBody( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv; int code, objc; Tcl_Size i, numHandlers = 0; handlersObj = (Tcl_Obj *)data[0]; finallyObj = (Tcl_Obj *)data[1]; objv = (Tcl_Obj **)data[2]; objc = PTR2INT(data[3]); cmdObj = objv[0]; |
︙ | ︙ | |||
4926 4927 4928 4929 4930 4931 4932 | if (handlersObj != NULL) { int found = 0; Tcl_Obj **handlers, **info; TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *handlerBodyObj; | | | | 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 | if (handlersObj != NULL) { int found = 0; Tcl_Obj **handlers, **info; TclListObjGetElementsM(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *handlerBodyObj; Tcl_Size numElems = 0; TclListObjGetElementsM(NULL, handlers[i], &numElems, &info); if (!found) { Tcl_GetIntFromObj(NULL, info[1], &code); if (code != result) { continue; } /* * When processing an error, we must also perform list-prefix * matching of the errorcode list. However, if this was an * 'on' handler, the list that we are matching against will be * empty. */ if (code == TCL_ERROR) { Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2; Tcl_Size len1, len2, j; TclNewLiteralStringObj(errorCodeName, "-errorcode"); Tcl_DictObjGet(NULL, options, errorCodeName, &errcode); Tcl_DecrRefCount(errorCodeName); TclListObjGetElementsM(NULL, info[2], &len1, &bits1); if (TclListObjGetElementsM(NULL, errcode, &len2, &bits2) != TCL_OK) { |
︙ | ︙ | |||
5298 5299 5300 5301 5302 5303 5304 | */ void TclListLines( Tcl_Obj *listObj, /* Pointer to obj holding a string with list * structure. Assumed to be valid. Assumed to * contain n elements. */ | | | 5296 5297 5298 5299 5300 5301 5302 5303 5304 5305 5306 5307 5308 5309 5310 | */ void TclListLines( Tcl_Obj *listObj, /* Pointer to obj holding a string with list * structure. Assumed to be valid. Assumed to * contain n elements. */ Tcl_Size line, /* Line the list as a whole starts on. */ int n, /* #elements in lines */ int *lines, /* Array of line numbers, to fill. */ Tcl_Obj *const *elems) /* The list elems as Tcl_Obj*, in need of * derived continuation data */ { const char *listStr = TclGetString(listObj); const char *listHead = listStr; |
︙ | ︙ |
Changes to generic/tclCompCmds.c.
︙ | ︙ | |||
283 284 285 286 287 288 289 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; int isScalar, localIndex, code = TCL_OK; int isDataLiteral, isDataValid, isDataEven; | | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varTokenPtr, *dataTokenPtr; int isScalar, localIndex, code = TCL_OK; int isDataLiteral, isDataValid, isDataEven; Tcl_Size len; int keyVar, valVar, infoIndex; int fwd, offsetBack, offsetFwd; Tcl_Obj *literalObj; ForeachInfo *infoPtr; if (parsePtr->numWords != 3) { return TCL_ERROR; |
︙ | ︙ | |||
389 390 391 392 393 394 395 | */ keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 | */ keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *)); infoPtr->numLists = 1; infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr); /* * Start issuing instructions to write to the array. |
︙ | ︙ | |||
887 888 889 890 891 892 893 | break; } (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; | | | 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 | break; } (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } if (listObj != NULL) { Tcl_Obj **objs; const char *bytes; Tcl_Size len, slen; TclListObjGetElementsM(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = Tcl_GetStringFromObj(objPtr, &slen); PushLiteral(envPtr, bytes, slen); Tcl_DecrRefCount(objPtr); |
︙ | ︙ | |||
1074 1075 1076 1077 1078 1079 1080 | /* * Parse the increment amount, if present. */ if (parsePtr->numWords == 4) { const char *word; | | | 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 | /* * Parse the increment amount, if present. */ if (parsePtr->numWords == 4) { const char *word; Tcl_Size numBytes; int code; Tcl_Token *incrTokenPtr; Tcl_Obj *intObj; incrTokenPtr = TokenAfter(keyTokenPtr); if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr); |
︙ | ︙ | |||
1289 1290 1291 1292 1293 1294 1295 | { DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; int i; | | | 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 | { DefineLineInformation; /* TIP #280 */ int worker; /* Temp var for building the value in. */ Tcl_Token *tokenPtr; Tcl_Obj *keyObj, *valueObj, *dictObj; const char *bytes; int i; Tcl_Size len; if ((parsePtr->numWords & 1) == 0) { return TCL_ERROR; } /* * See if we can build the value at compile time... |
︙ | ︙ | |||
1524 1525 1526 1527 1528 1529 1530 | * construct a new dictionary with the loop * body result. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; | | | 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 | * construct a new dictionary with the loop * body result. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; Tcl_Size numVars; int endTargetOffset; int collectVar = -1; /* Index of temp var holding the result * dict. */ const char **argv; Tcl_DString buffer; /* |
︙ | ︙ | |||
2292 2293 2294 2295 2296 2297 2298 | PrintDictUpdateInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; | | | | | | 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 | PrintDictUpdateInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; Tcl_Size i; for (i=0 ; i<duiPtr->length ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]); } } static void DisassembleDictUpdateInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData; Tcl_Size i; Tcl_Obj *variables; TclNewObj(variables); for (i=0 ; i<duiPtr->length ; i++) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewWideIntObj(duiPtr->varIndices[i])); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1), variables); } /* *---------------------------------------------------------------------- * * TclCompileErrorCmd -- |
︙ | ︙ | |||
2686 2687 2688 2689 2690 2691 2692 | ForeachInfo *infoPtr=NULL; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; int numWords, numLists, i, code = TCL_OK; | | | 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 | ForeachInfo *infoPtr=NULL; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ Tcl_Token *tokenPtr, *bodyTokenPtr; int jumpBackOffset, infoIndex, range; int numWords, numLists, i, code = TCL_OK; Tcl_Size j; Tcl_Obj *varListObj = NULL; /* * If the foreach command isn't in a procedure, don't compile it inline: * the payoff is too small. */ |
︙ | ︙ | |||
2738 2739 2740 2741 2742 2743 2744 | */ TclNewObj(varListObj); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; | | | | | 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 | */ TclNewObj(varListObj); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { ForeachVarList *varListPtr; Tcl_Size numVars; if (i%2 != 1) { continue; } /* * If the variable list is empty, we can enter an infinite loop when * the interpreted version would not. Take care to ensure this does * not happen. [Bug 1671138] */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) || numVars == 0) { code = TCL_ERROR; goto done; } varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + numVars * sizeof(varListPtr->varIndexes[0])); varListPtr->numVars = numVars; infoPtr->varLists[i/2] = varListPtr; infoPtr->numLists++; for (j = 0; j < numVars; j++) { Tcl_Obj *varNameObj; const char *bytes; int varIndex; Tcl_Size length; Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = Tcl_GetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); if (varIndex < 0) { code = TCL_ERROR; |
︙ | ︙ | |||
2976 2977 2978 2979 2980 2981 2982 | void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; | | | | | | | | | | | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 | void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; Tcl_Size i, j; Tcl_AppendToObj(appendObj, "data=[", -1); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", (infoPtr->firstValueTemp + i)); } Tcl_AppendPrintfToObj(appendObj, "], loop=%%v%" TCL_Z_MODIFIER "u", infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "\n\t\t it%%v%" TCL_Z_MODIFIER "u\t[", (infoPtr->firstValueTemp + i)); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { if (j) { Tcl_AppendToObj(appendObj, ", ", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } } static void PrintNewForeachInfo( void *clientData, Tcl_Obj *appendObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; Tcl_Size i, j; Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=", infoPtr->loopCtTemp); for (i=0 ; i<infoPtr->numLists ; i++) { if (i) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendToObj(appendObj, "[", -1); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { if (j) { Tcl_AppendToObj(appendObj, ",", -1); } Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", varsPtr->varIndexes[j]); } Tcl_AppendToObj(appendObj, "]", -1); } } static void DisassembleForeachInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; Tcl_Size i, j; Tcl_Obj *objPtr, *innerPtr; /* * Data stores. */ TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj(infoPtr->firstValueTemp + i)); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr); /* * Loop counter. */ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1), Tcl_NewWideIntObj(infoPtr->loopCtTemp)); /* * Assignment targets. */ TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, Tcl_NewWideIntObj(varsPtr->varIndexes[j])); } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } static void DisassembleNewForeachInfo( void *clientData, Tcl_Obj *dictObj, TCL_UNUSED(ByteCode *), TCL_UNUSED(size_t)) { ForeachInfo *infoPtr = (ForeachInfo *)clientData; ForeachVarList *varsPtr; Tcl_Size i, j; Tcl_Obj *objPtr, *innerPtr; /* * Jump offset. */ Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1), Tcl_NewWideIntObj(infoPtr->loopCtTemp)); /* * Assignment targets. */ TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, Tcl_NewWideIntObj(varsPtr->varIndexes[j])); } Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } /* *---------------------------------------------------------------------- * * TclCompileFormatCmd -- * |
︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
︙ | ︙ | |||
2264 2265 2266 2267 2268 2269 2270 | { DefineLineInformation; /* TIP #280 */ /* * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, status = TCL_OK; | | | 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 | { DefineLineInformation; /* TIP #280 */ /* * General syntax: [return ?-option value ...? ?result?] * An even number of words means an explicit result argument is present. */ int level, code, objc, status = TCL_OK; Tcl_Size size; int numWords = parsePtr->numWords; int explicitResult = (0 == (numWords % 2)); int numOptionWords = numWords - 1 - explicitResult; Tcl_Obj *returnOpts, **objv; Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr); /* |
︙ | ︙ | |||
2474 2475 2476 2477 2478 2479 2480 | void TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); | | | 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 | void TclCompileSyntaxError( Tcl_Interp *interp, CompileEnv *envPtr) { Tcl_Obj *msg = Tcl_GetObjResult(interp); Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(msg, &numBytes); TclErrorStackResetIf(interp, bytes, numBytes); TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr); CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0, TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR))); Tcl_ResetResult(interp); |
︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
︙ | ︙ | |||
917 918 919 920 921 922 923 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; | | | 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 | * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *mapTokenPtr, *stringTokenPtr; Tcl_Obj *mapObj, **objv; const char *bytes; Tcl_Size len, slen; /* * We only handle the case: * * string map {foo bar} $thing * * That is, a literal two-element list (doesn't need to be brace-quoted, |
︙ | ︙ | |||
1513 1514 1515 1516 1517 1518 1519 | return TCL_OK; } void TclSubstCompile( Tcl_Interp *interp, const char *bytes, | | | | | 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 | return TCL_OK; } void TclSubstCompile( Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, int flags, Tcl_Size line, CompileEnv *envPtr) { Tcl_Token *endTokenPtr, *tokenPtr; int breakOffset = 0, count = 0; Tcl_Size bline = line; Tcl_Parse parse; Tcl_InterpState state = NULL; TclSubstParse(interp, bytes, numBytes, flags, &parse, &state); if (state != NULL) { Tcl_ResetResult(interp); } |
︙ | ︙ | |||
1545 1546 1547 1548 1549 1550 1551 | if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { PUSH(""); count++; } for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { | | | 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 | if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) { PUSH(""); count++; } for (endTokenPtr = tokenPtr + parse.numTokens; tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) { Tcl_Size length; int literal, catchRange, breakJump; char buf[4] = ""; JumpFixup startFixup, okFixup, returnFixup, breakFixup; JumpFixup continueFixup, otherFixup, endFixup; switch (tokenPtr->type) { case TCL_TOKEN_TEXT: |
︙ | ︙ | |||
1577 1578 1579 1580 1581 1582 1583 | * TCL_OK or TCL_ERROR from the substituted variable read; if so, * there is no need to generate elaborate exception-management * code. Note that the first component of TCL_TOKEN_VARIABLE is * always TCL_TOKEN_TEXT... */ if (tokenPtr->numComponents > 1) { | | | 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 | * TCL_OK or TCL_ERROR from the substituted variable read; if so, * there is no need to generate elaborate exception-management * code. Note that the first component of TCL_TOKEN_VARIABLE is * always TCL_TOKEN_TEXT... */ if (tokenPtr->numComponents > 1) { Tcl_Size i; int foundCommand = 0; for (i=2 ; i<=tokenPtr->numComponents ; i++) { if (tokenPtr[i].type == TCL_TOKEN_COMMAND) { foundCommand = 1; break; } |
︙ | ︙ | |||
1941 1942 1943 1944 1945 1946 1947 | * copies of the string from the input token for the generated tokens (it * causes a crash during exception handling). When multiple tokens are * available at this point, this is pretty easy. */ if (numWords == 1) { const char *bytes; | | | | 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 | * copies of the string from the input token for the generated tokens (it * causes a crash during exception handling). When multiple tokens are * available at this point, this is pretty easy. */ if (numWords == 1) { const char *bytes; Tcl_Size maxLen, numBytes; Tcl_Size bline; /* TIP #280: line of the pattern/action list, * and start of list for when tracking the * location. This list comes immediately after * the value we switch on. */ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { return TCL_ERROR; } |
︙ | ︙ | |||
2600 2601 2602 2603 2604 2605 2606 | hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); if (i++) { | | | | 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 | hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); if (i++) { Tcl_AppendToObj(appendObj, ", ", -1); if (i%4==0) { Tcl_AppendToObj(appendObj, "\n\t\t", -1); } } Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %" TCL_Z_MODIFIER "u", keyPtr, pcOffset + offset); } } |
︙ | ︙ | |||
2629 2630 2631 2632 2633 2634 2635 | size_t offset; TclNewObj(mapping); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); | | | | 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 | size_t offset; TclNewObj(mapping); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr); offset = PTR2INT(Tcl_GetHashValue(hPtr)); Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1), Tcl_NewWideIntObj(offset)); } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping); } /* *---------------------------------------------------------------------- * * TclCompileTailcallCmd -- * |
︙ | ︙ | |||
2712 2713 2714 2715 2716 2717 2718 | CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; int codeKnown, codeIsList, codeIsValid; | | | 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 | CompileEnv *envPtr) /* Holds resulting instructions. */ { DefineLineInformation; /* TIP #280 */ int numWords = parsePtr->numWords; Tcl_Token *codeToken, *msgToken; Tcl_Obj *objPtr; int codeKnown, codeIsList, codeIsValid; Tcl_Size len; if (numWords != 3) { return TCL_ERROR; } codeToken = TokenAfter(parsePtr->tokenPtr); msgToken = TokenAfter(codeToken); |
︙ | ︙ | |||
2853 2854 2855 2856 2857 2858 2859 | memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers); matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *tmpObj, **objv; | | | 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 | memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers); matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *tmpObj, **objv; Tcl_Size objc; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { goto failedToCompile; } if (tokenPtr[1].size == 4 && !strncmp(tokenPtr[1].start, "trap", 4)) { /* |
︙ | ︙ | |||
2918 2919 2920 2921 2922 2923 2924 | } if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { | | | | 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 | } if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; } if (objc > 0) { Tcl_Size len; const char *varname = Tcl_GetStringFromObj(objv[0], &len); resultVarIndices[i] = LocalScalar(varname, len, envPtr); if (resultVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } } else { resultVarIndices[i] = -1; } if (objc == 2) { Tcl_Size len; const char *varname = Tcl_GetStringFromObj(objv[1], &len); optionVarIndices[i] = LocalScalar(varname, len, envPtr); if (optionVarIndices[i] < 0) { TclDecrRefCount(tmpObj); goto failedToCompile; } |
︙ | ︙ | |||
3052 3053 3054 3055 3056 3057 3058 | int *resultVars, int *optionVars, Tcl_Token **handlerTokens) { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; | | | 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 | int *resultVars, int *optionVars, Tcl_Token **handlerTokens) { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar; int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0; Tcl_Size slen, len; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; int *noError; char buf[TCL_INTEGER_SPACE]; resultVar = AnonymousLocal(envPtr); optionsVar = AnonymousLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { |
︙ | ︙ | |||
3266 3267 3268 3269 3270 3271 3272 | Tcl_Token *finallyToken) /* Not NULL */ { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0; int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; | | | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 | Tcl_Token *finallyToken) /* Not NULL */ { DefineLineInformation; /* TIP #280 */ int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0; int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError; int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource; char buf[TCL_INTEGER_SPACE]; Tcl_Size slen, len; resultVar = AnonymousLocal(envPtr); optionsVar = AnonymousLocal(envPtr); if (resultVar < 0 || optionsVar < 0) { return TCL_ERROR; } |
︙ | ︙ | |||
3676 3677 3678 3679 3680 3681 3682 | continue; } } return TCL_ERROR; } if (varCount == 0) { const char *bytes; | | | 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 | continue; } } return TCL_ERROR; } if (varCount == 0) { const char *bytes; Tcl_Size len; bytes = Tcl_GetStringFromObj(leadingWord, &len); if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) { flags = 0; haveFlags++; } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) { haveFlags++; |
︙ | ︙ | |||
4069 4070 4071 4072 4073 4074 4075 | Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; | | | | 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 | Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ for (words=1 ; words<parsePtr->numWords ; words++) { tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, words); } if (parsePtr->numWords <= 2) { PushLiteral(envPtr, identity, -1); words++; } if (words > 3) { /* * Reverse order of arguments to get precise agreement with [expr] in * calculations, including roundoff errors. */ |
︙ | ︙ | |||
4172 4173 4174 4175 4176 4177 4178 | /* * No local variable space! */ return TCL_ERROR; } else { int tmpIndex = AnonymousLocal(envPtr); | | | 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 | /* * No local variable space! */ return TCL_ERROR; } else { int tmpIndex = AnonymousLocal(envPtr); Tcl_Size words; tokenPtr = TokenAfter(parsePtr->tokenPtr); CompileWord(envPtr, tokenPtr, interp, 1); tokenPtr = TokenAfter(tokenPtr); CompileWord(envPtr, tokenPtr, interp, 2); STORE(tmpIndex); TclEmitOpcode(instruction, envPtr); |
︙ | ︙ | |||
4308 4309 4310 4311 4312 4313 4314 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; | | | 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Size words; /* * This one has its own implementation because the ** operator is the only * one with right associativity. */ for (words=1 ; words<parsePtr->numWords ; words++) { |
︙ | ︙ | |||
4509 4510 4511 4512 4513 4514 4515 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; | | | 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ |
︙ | ︙ | |||
4554 4555 4556 4557 4558 4559 4560 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; | | | 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 | Tcl_Interp *interp, Tcl_Parse *parsePtr, TCL_UNUSED(Command *), CompileEnv *envPtr) { DefineLineInformation; /* TIP #280 */ Tcl_Token *tokenPtr = parsePtr->tokenPtr; Tcl_Size words; /* TODO: Consider support for compiling expanded args. */ if (parsePtr->numWords == 1) { /* * Fallback to direct eval to report syntax error. */ |
︙ | ︙ |
Changes to generic/tclCompExpr.c.
︙ | ︙ | |||
507 508 509 510 511 512 513 | * Declarations for local functions to this file: */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); | | | | | 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 | * Declarations for local functions to this file: */ static void CompileExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj *const **litObjvPtr, Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr, CompileEnv *envPtr, int optimize); static void ConvertTreeToTokens(const char *start, Tcl_Size numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr); static int ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes, int index, Tcl_Obj * const **litObjvPtr); static int ParseExpr(Tcl_Interp *interp, const char *start, Tcl_Size numBytes, OpNode **opTreePtr, Tcl_Obj *litList, Tcl_Obj *funcList, Tcl_Parse *parsePtr, int parseOnly); static Tcl_Size ParseLexeme(const char *start, Tcl_Size numBytes, unsigned char *lexemePtr, Tcl_Obj **literalPtr); /* *---------------------------------------------------------------------- * * ParseExpr -- * |
︙ | ︙ | |||
554 555 556 557 558 559 560 | *---------------------------------------------------------------------- */ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ | | | 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 | *---------------------------------------------------------------------- */ static int ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ Tcl_Size numBytes, /* Number of bytes in string. */ OpNode **opTreePtr, /* Points to space where a pointer to the * allocated OpNode tree should go. */ Tcl_Obj *litList, /* List to append literals to. */ Tcl_Obj *funcList, /* List to append function names to. */ Tcl_Parse *parsePtr, /* Structure to fill with tokens representing * those operands that require run time * substitutions. */ |
︙ | ︙ | |||
577 578 579 580 581 582 583 | unsigned int nodesAvailable = 64; /* Initial size of the storage array. This * value establishes a minimum tree memory * cost of only about 1 kilobyte, and is large * enough for most expressions to parse with * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ | | | 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 | unsigned int nodesAvailable = 64; /* Initial size of the storage array. This * value establishes a minimum tree memory * cost of only about 1 kilobyte, and is large * enough for most expressions to parse with * no need for array growth and * reallocation. */ unsigned int nodesUsed = 0; /* Number of OpNodes filled. */ Tcl_Size scanned = 0; /* Capture number of byte scanned by parsing * routines. */ int lastParsed; /* Stores info about what the lexeme parsed * the previous pass through the parsing loop * was. If it was an operator, lastParsed is * the index of the OpNode for that operator. * If it was not an operator, lastParsed holds * an OperandTypes value encoding what we need |
︙ | ︙ | |||
621 622 623 624 625 626 627 | * message where the error location is * reported, this "mark" substring is inserted * into the string being parsed to aid in * pinpointing the location of the syntax * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ | | | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | * message where the error location is * reported, this "mark" substring is inserted * into the string being parsed to aid in * pinpointing the location of the syntax * error in the expression. */ int insertMark = 0; /* A boolean controlling whether the "mark" * should be inserted. */ const int limit = 25; /* Portions of the error message are * constructed out of substrings of the * original expression. In order to keep the * error message readable, we impose this * limit on the substring size we extract. */ TclParseInit(interp, start, numBytes, parsePtr); |
︙ | ︙ | |||
773 774 775 776 777 778 779 | Tcl_ListObjAppendElement(NULL, funcList, literal); scanned = scanned2 - 1; break; } Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", | | | | | | | | | 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 | Tcl_ListObjAppendElement(NULL, funcList, literal); scanned = scanned2 - 1; break; } Tcl_DecrRefCount(literal); msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"", (int)((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); post = Tcl_ObjPrintf( "should be \"$%.*s%s\" or \"{%.*s%s}\"", (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "...", (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...", (int) ((scanned < limit) ? scanned : limit - 3), start, (scanned < limit) ? "" : "..."); errCode = "BAREWORD"; if (start[0] == '0') { const char *stop; TclParseNumber(NULL, NULL, NULL, start, scanned, &stop, TCL_PARSE_NO_WHITESPACE); if (isdigit(UCHAR(*stop)) || (stop == start + 1)) { switch (start[1]) { case 'b': Tcl_AppendToObj(post, " (invalid binary number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "BINARY"; break; case 'o': Tcl_AppendToObj(post, " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; break; default: if (isdigit(UCHAR(start[1]))) { Tcl_AppendToObj(post, " (invalid octal number?)", -1); parsePtr->errorType = TCL_PARSE_BAD_NUMBER; errCode = "BADNUMBER"; subErrCode = "OCTAL"; } break; } } |
︙ | ︙ | |||
1458 1459 1460 1461 1462 1463 1464 | (start + scanned + limit > parsePtr->end) ? "" : "..."); /* * Next, append any postscript message. */ if (post != NULL) { | | | 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 | (start + scanned + limit > parsePtr->end) ? "" : "..."); /* * Next, append any postscript message. */ if (post != NULL) { Tcl_AppendToObj(msg, ";\n", -1); Tcl_AppendObjToObj(msg, post); Tcl_DecrRefCount(post); } Tcl_SetObjResult(interp, msg); /* * Finally, place context information in the errorInfo. |
︙ | ︙ | |||
1508 1509 1510 1511 1512 1513 1514 | * *---------------------------------------------------------------------- */ static void ConvertTreeToTokens( const char *start, | | | 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 | * *---------------------------------------------------------------------- */ static void ConvertTreeToTokens( const char *start, Tcl_Size numBytes, OpNode *nodes, Tcl_Token *tokenPtr, Tcl_Parse *parsePtr) { int subExprTokenIdx = 0; OpNode *nodePtr = nodes; int next = nodePtr->right; |
︙ | ︙ | |||
1856 1857 1858 1859 1860 1861 1862 | *---------------------------------------------------------------------- */ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ | | | | 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 | *---------------------------------------------------------------------- */ int Tcl_ParseExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *start, /* Start of source string to parse. */ Tcl_Size numBytes, /* Number of bytes in string. If -1, the * string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr) /* Structure to fill with information about * the parsed expression; any previous * information in the structure is ignored. */ { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ Tcl_Obj *litList; /* List to hold the literals. */ Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ TclNewObj(litList); TclNewObj(funcList); if (numBytes < 0) { numBytes = (start ? strlen(start) : 0); } code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); Tcl_DecrRefCount(funcList); Tcl_DecrRefCount(litList); |
︙ | ︙ | |||
1913 1914 1915 1916 1917 1918 1919 | * * Side effects: * Code identifying lexeme parsed is written to *lexemePtr. * *---------------------------------------------------------------------- */ | | | | 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 | * * Side effects: * Code identifying lexeme parsed is written to *lexemePtr. * *---------------------------------------------------------------------- */ static Tcl_Size ParseLexeme( const char *start, /* Start of lexeme to parse. */ Tcl_Size numBytes, /* Number of bytes in string. */ unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this storage, if non-NULL. */ { const char *end; int ch; |
︙ | ︙ | |||
1941 1942 1943 1944 1945 1946 1947 | return 1; } switch (byte) { case '#': { /* * Scan forward over the comment contents. */ | | | 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 | return 1; } switch (byte) { case '#': { /* * Scan forward over the comment contents. */ Tcl_Size size; for (size = 0; byte != '\n' && byte != 0 && size < numBytes; size++) { byte = UCHAR(start[size]); } *lexemePtr = COMMENT; return size - (byte == '\n'); } |
︙ | ︙ | |||
2143 2144 2145 2146 2147 2148 2149 | /* * We reject leading underscores in bareword. No sensible reason why. * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { | | | 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 | /* * We reject leading underscores in bareword. No sensible reason why. * Might be inspired by reserved identifier rules in C, which of course * have no direct relevance here. */ if (!TclIsBareword(*start) || *start == '_') { Tcl_Size scanned; if (Tcl_UtfCharComplete(start, numBytes)) { scanned = TclUtfToUCS4(start, &ch); } else { char utfBytes[8]; memcpy(utfBytes, start, numBytes); utfBytes[numBytes] = '\0'; |
︙ | ︙ | |||
2193 2194 2195 2196 2197 2198 2199 | *---------------------------------------------------------------------- */ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ | | | | 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 | *---------------------------------------------------------------------- */ void TclCompileExpr( Tcl_Interp *interp, /* Used for error reporting. */ const char *script, /* The source script to compile. */ Tcl_Size numBytes, /* Number of bytes in script. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int optimize) /* 0 for one-off expressions. */ { OpNode *opTree = NULL; /* Will point to the tree of operators */ Tcl_Obj *litList; /* List to hold the literals */ Tcl_Obj *funcList; /* List to hold the functon names*/ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ int code; TclNewObj(litList); TclNewObj(funcList); code = ParseExpr(interp, script, numBytes, &opTree, litList, funcList, parsePtr, 0 /* parseOnly */); if (code == TCL_OK) { /* * Valid parse; compile the tree. */ Tcl_Size objc; Tcl_Obj *const *litObjv; Tcl_Obj **funcObjv; /* TIP #280 : Track Lines within the expression */ TclAdvanceLines(&envPtr->line, script, script + TclParseAllWhiteSpace(script, numBytes)); |
︙ | ︙ | |||
2344 2345 2346 2347 2348 2349 2350 | } else if (nodePtr->mark == MARK_RIGHT) { next = nodePtr->right; switch (nodePtr->lexeme) { case FUNCTION: { Tcl_DString cmdName; const char *p; | | | 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 | } else if (nodePtr->mark == MARK_RIGHT) { next = nodePtr->right; switch (nodePtr->lexeme) { case FUNCTION: { Tcl_DString cmdName; const char *p; Tcl_Size length; Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::"); p = Tcl_GetStringFromObj(*funcObjv, &length); funcObjv++; Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterLiteral(envPtr, |
︙ | ︙ | |||
2503 2504 2505 2506 2507 2508 2509 | numWords = 1; /* No arguments, so just the command */ break; case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { | | | 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 | numWords = 1; /* No arguments, so just the command */ break; case OT_LITERAL: { Tcl_Obj *const *litObjv = *litObjvPtr; Tcl_Obj *literal = *litObjv; if (optimize) { Tcl_Size length; const char *bytes = Tcl_GetStringFromObj(literal, &length); int idx = TclRegisterLiteral(envPtr, bytes, length, 0); Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx); if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) { /* * Would like to do this: |
︙ | ︙ | |||
2562 2563 2564 2565 2566 2567 2568 | /* * Don't generate a string rep, but if we have one * already, then use it to share via the literal table. */ if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; | | | 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 | /* * Don't generate a string rep, but if we have one * already, then use it to share via the literal table. */ if (TclHasStringRep(objPtr)) { Tcl_Obj *tableValue; Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0); tableValue = TclFetchLiteral(envPtr, idx); if ((tableValue->typePtr == NULL) && (objPtr->typePtr != NULL)) { |
︙ | ︙ |
Changes to generic/tclCompile.c.
︙ | ︙ | |||
676 677 678 679 680 681 682 | static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, | | | | | | 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 | static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, Tcl_Size cmdNumber, Tcl_Size numSrcBytes, Tcl_Size numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, Tcl_Size cmdNumber, Tcl_Size srcOffset, Tcl_Size codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(CompileEnv *envPtr); static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void StartExpanding(CompileEnv *envPtr); /* * TIP #280: Helper for building the per-word line information of all compiled * commands. */ static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset, Tcl_Token *tokenPtr, const char *cmd, Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* * tclByteCodeType provides the standard type management procedures for the * bytecode type. */ |
︙ | ︙ | |||
1387 1388 1389 1390 1391 1392 1393 | TclReleaseByteCode(codePtr); } static void ReleaseCmdWordData( ExtCmdLoc *eclPtr) { | | | 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 | TclReleaseByteCode(codePtr); } static void ReleaseCmdWordData( ExtCmdLoc *eclPtr) { Tcl_Size i; if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; i<eclPtr->nuloc ; i++) { Tcl_Free(eclPtr->loc[i].line); } |
︙ | ︙ | |||
1549 1550 1551 1552 1553 1554 1555 | * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(ctxPtr); pc = 1; } | | | 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 | * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(ctxPtr); pc = 1; } if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) { /* * Word is not a literal, relative counting. */ envPtr->line = 1; envPtr->extCmdMapPtr->type = (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC); |
︙ | ︙ | |||
1643 1644 1645 1646 1647 1648 1649 | } if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would * have transferred to it. */ | | | 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 | } if (envPtr->iPtr) { /* * We never converted to Bytecode, so free the things we would * have transferred to it. */ Tcl_Size i; LiteralEntry *entryPtr = envPtr->literalArrayPtr; AuxData *auxDataPtr = envPtr->auxDataArrayPtr; for (i = 0; i < envPtr->literalArrayNext; i++) { TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr); entryPtr++; } |
︙ | ︙ | |||
2157 2158 2159 2160 2161 2162 2163 | * nested calls of TclCompileScript, considering interp recursionlimit. * Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the * limit during "mixed" evaluation and compilation process (nested * eval+compile) and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 | * nested calls of TclCompileScript, considering interp recursionlimit. * Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the * limit during "mixed" evaluation and compilation process (nested * eval+compile) and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested compilations (infinite loop?)", -1)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL); TclCompileSyntaxError(interp, envPtr); return; } /* Each iteration compiles one command from the script. */ |
︙ | ︙ | |||
2319 2320 2321 2322 2323 2324 2325 | void TclCompileVarSubst( Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; | | | | 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 | void TclCompileVarSubst( Tcl_Interp *interp, Tcl_Token *tokenPtr, CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; Tcl_Size i, nameBytes = tokenPtr[1].size; Tcl_Size localVar; int localVarName = 1; /* * Determine how the variable name should be handled: if it contains any * namespace qualifiers it is not a local variable (localVarName=-1); if * it looks like an array element and the token has a single component, it * should not be created here [Bug 569438] (localVarName=0); otherwise, |
︙ | ︙ | |||
2348 2349 2350 2351 2352 2353 2354 | } /* * Either push the variable's name, or find its index in the array * of local variables in a procedure frame. */ | | | | | | 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 | } /* * Either push the variable's name, or find its index in the array * of local variables in a procedure frame. */ localVar = -1; if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } if (localVar < 0) { PushLiteral(envPtr, name, nameBytes); } /* * Emit instructions to load the variable. */ TclAdvanceLines(&envPtr->line, tokenPtr[1].start, tokenPtr[1].start + tokenPtr[1].size); if (tokenPtr->numComponents == 1) { if (localVar < 0) { TclEmitOpcode(INST_LOAD_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr); } else { TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr); } } else { TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr); if (localVar < 0) { TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr); } else if (localVar <= 255) { TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr); } else { TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr); } } |
︙ | ︙ | |||
2772 2773 2774 2775 2776 2777 2778 | */ static void PreventCycle( Tcl_Obj *objPtr, CompileEnv *envPtr) { | | | | 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 | */ static void PreventCycle( Tcl_Obj *objPtr, CompileEnv *envPtr) { Tcl_Size i; for (i = 0; i < envPtr->literalArrayNext; i++) { if (objPtr == TclFetchLiteral(envPtr, i)) { /* * Prevent circular reference where the bytecode internalrep of * a value contains a literal which is that same value. * If this is allowed to happen, refcount decrements may not * reach zero, and memory may leak. Bugs 467523, 3357771 * * NOTE: [Bugs 3392070, 3389764] We make a copy based completely * on the string value, and do not call Tcl_DuplicateObj() so we * can be sure we do not have any lingering cycles hiding in * the internalrep. */ Tcl_Size numBytes; const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); Tcl_IncrRefCount(copyPtr); TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); envPtr->literalArrayPtr[i].objPtr = copyPtr; |
︙ | ︙ | |||
2989 2990 2991 2992 2993 2994 2995 | * Side effects: * Creates and registers a new local variable if create is 1 and the * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ | | | | | | | | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 | * Side effects: * Creates and registers a new local variable if create is 1 and the * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ Tcl_Size TclFindCompiledLocal( const char *name, /* Points to first character of the name of a * scalar or array variable. If NULL, a * temporary var should be created. */ Tcl_Size nameBytes, /* Number of bytes in the name. */ int create, /* If 1, allocate a local frame entry for the * variable if it is new. */ CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; Tcl_Size localVar = TCL_INDEX_NONE; Tcl_Size i; Proc *procPtr; /* * If not creating a temporary, does a local variable of the specified * name already exist? */ procPtr = envPtr->procPtr; if (procPtr == NULL) { /* * Compiling a non-body script: give it read access to the LVT in the * current localCache */ LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr; const char *localName; Tcl_Obj **varNamePtr; Tcl_Size len; if (!cachePtr || !name) { return TCL_INDEX_NONE; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { localName = Tcl_GetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } } } return TCL_INDEX_NONE; } if (name != NULL) { Tcl_Size localCt = procPtr->numCompiledLocals; localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { if (!TclIsVarTemporary(localPtr)) { char *localName = localPtr->name; if ((nameBytes == localPtr->nameLength) && |
︙ | ︙ | |||
3167 3168 3169 3170 3171 3172 3173 | */ static void EnterCmdStartData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ | | | | | | 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 | */ static void EnterCmdStartData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ Tcl_Size cmdIndex, /* Index of the command whose start data is * being set. */ Tcl_Size srcOffset, /* Offset of first char of the command. */ Tcl_Size codeOffset) /* Offset of first byte of command code. */ { CmdLocation *cmdLocPtr; if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } if (cmdIndex >= envPtr->cmdMapEnd) { /* * Expand the command location array by allocating more storage from * the heap. The currently allocated CmdLocation entries are stored |
︙ | ︙ | |||
3246 3247 3248 3249 3250 3251 3252 | */ static void EnterCmdExtentData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ | | | | | | 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 | */ static void EnterCmdExtentData( CompileEnv *envPtr, /* Points to the compilation environment * structure in which to enter command * location information. */ Tcl_Size cmdIndex, /* Index of the command whose source and code * length data is being set. */ Tcl_Size numSrcBytes, /* Number of command source chars. */ Tcl_Size numCodeBytes) /* Offset of last byte of command code. */ { CmdLocation *cmdLocPtr; if (cmdIndex < 0 || cmdIndex >= envPtr->numCommands) { Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex); } if (cmdIndex > envPtr->cmdMapEnd) { Tcl_Panic("EnterCmdExtentData: missing start data for command %" TCL_Z_MODIFIER "u", cmdIndex); } |
︙ | ︙ | |||
3292 3293 3294 3295 3296 3297 3298 | */ static void EnterCmdWordData( ExtCmdLoc *eclPtr, /* Points to the map environment structure in * which to enter command location * information. */ | | | | | | 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 | */ static void EnterCmdWordData( ExtCmdLoc *eclPtr, /* Points to the map environment structure in * which to enter command location * information. */ Tcl_Size srcOffset, /* Offset of first char of the command. */ Tcl_Token *tokenPtr, const char *cmd, Tcl_Size numWords, Tcl_Size line, int *clNext, int **wlines, CompileEnv *envPtr) { ECL *ePtr; const char *last; Tcl_Size wordIdx, wordLine; int *wwlines, *wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { /* * Expand the ECL array by allocating more storage from the heap. The * currently allocated ECL entries are stored from eclPtr->loc[0] up * to eclPtr->loc[eclPtr->nuloc-1] (inclusive). |
︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 | * the array in expanded: a new array of double the size is allocated, if * envPtr->mallocedExceptArray is non-zero the old array is freed, and * ExceptionRange entries are copied from the old array to the new one. * *---------------------------------------------------------------------- */ | | | | 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 | * the array in expanded: a new array of double the size is allocated, if * envPtr->mallocedExceptArray is non-zero the old array is freed, and * ExceptionRange entries are copied from the old array to the new one. * *---------------------------------------------------------------------- */ Tcl_Size TclCreateExceptRange( ExceptionRangeType type, /* The kind of ExceptionRange desired. */ CompileEnv *envPtr)/* Points to CompileEnv for which to create a * new ExceptionRange structure. */ { ExceptionRange *rangePtr; ExceptionAux *auxPtr; Tcl_Size index = envPtr->exceptArrayNext; if (index >= envPtr->exceptArrayEnd) { /* * Expand the ExceptionRange array. The currently allocated entries * are stored between elements 0 and (envPtr->exceptArrayNext - 1) * [inclusive]. */ |
︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | * * Side effects: * If there is not enough room in the CompileEnv's AuxData array, its size * is doubled. *---------------------------------------------------------------------- */ | | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 | * * Side effects: * If there is not enough room in the CompileEnv's AuxData array, its size * is doubled. *---------------------------------------------------------------------- */ Tcl_Size TclCreateAuxData( void *clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ CompileEnv *envPtr)/* Points to the CompileEnv for which a new * aux data structure is to be allocated. */ { Tcl_Size index; /* Index for the new AuxData structure. */ AuxData *auxDataPtr; /* Points to the new AuxData structure */ index = envPtr->auxDataArrayNext; if (index >= envPtr->auxDataArrayEnd) { /* * Expand the AuxData array. The currently allocated entries are |
︙ | ︙ | |||
4412 4413 4414 4415 4416 4417 4418 | ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; | | | | | | 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 | ByteCode *codePtr, /* ByteCode in which to encode envPtr's * command location information. */ unsigned char *startPtr) /* Points to the first byte in codePtr's * memory block where the location information * is to be stored. */ { CmdLocation *mapPtr = envPtr->cmdMapPtr; Tcl_Size i, codeDelta, codeLen, srcLen, prevOffset; Tcl_Size numCmds = envPtr->numCommands; unsigned char *p = startPtr; int srcDelta; /* * Encode the code offset for each command as a sequence of deltas. */ codePtr->codeDeltaStart = p; prevOffset = 0; for (i = 0; i < numCmds; i++) { codeDelta = mapPtr[i].codeOffset - prevOffset; if (codeDelta < 0) { Tcl_Panic("EncodeCmdLocMap: bad code offset"); } else if (codeDelta <= 127) { TclStoreInt1AtPtr(codeDelta, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; TclStoreInt4AtPtr(codeDelta, p); p += 4; } prevOffset = mapPtr[i].codeOffset; } /* * Encode the code length for each command. */ codePtr->codeLengthStart = p; for (i = 0; i < numCmds; i++) { codeLen = mapPtr[i].numCodeBytes; if (codeLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad code length"); } else if (codeLen <= 127) { TclStoreInt1AtPtr(codeLen, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; |
︙ | ︙ | |||
4486 4487 4488 4489 4490 4491 4492 | /* * Encode the source length for each command. */ codePtr->srcLengthStart = p; for (i = 0; i < numCmds; i++) { srcLen = mapPtr[i].numSrcBytes; | | | 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 | /* * Encode the source length for each command. */ codePtr->srcLengthStart = p; for (i = 0; i < numCmds; i++) { srcLen = mapPtr[i].numSrcBytes; if (srcLen < 0) { Tcl_Panic("EncodeCmdLocMap: bad source length"); } else if (srcLen <= 127) { TclStoreInt1AtPtr(srcLen, p); p++; } else { TclStoreInt1AtPtr(0xFF, p); p++; |
︙ | ︙ |
Changes to generic/tclCompile.h.
︙ | ︙ | |||
1111 1112 1113 1114 1115 1116 1117 | Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE Tcl_Size TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE Tcl_Size TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, | | | 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 | Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE Tcl_Size TclCreateAuxData(void *clientData, const AuxDataType *typePtr, CompileEnv *envPtr); MODULE_SCOPE Tcl_Size TclCreateExceptRange(ExceptionRangeType type, CompileEnv *envPtr); MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, size_t size); MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes, Tcl_Size length, size_t hash, int *newPtr, Namespace *nsPtr, int flags, LiteralEntry **globalPtrPtr); MODULE_SCOPE void TclDeleteExecEnv(ExecEnv *eePtr); MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); |
︙ | ︙ |
Changes to generic/tclConfig.c.
︙ | ︙ | |||
81 82 83 84 85 86 87 | cdPtr->interp = interp; if (valEncoding) { cdPtr->encoding = (char *)Tcl_Alloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; } | | | 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | cdPtr->interp = interp; if (valEncoding) { cdPtr->encoding = (char *)Tcl_Alloc(strlen(valEncoding)+1); strcpy(cdPtr->encoding, valEncoding); } else { cdPtr->encoding = NULL; } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of * package meta data. * * Phase II: Create a command for querying this database, specific to the * package registering its configuration. This is the approved interface |
︙ | ︙ | |||
123 124 125 126 127 128 129 | /* * Extend the package configuration... * We cannot assume that the encodings are initialized, therefore * store the value as-is in a byte array. See Bug [9b2e636361]. */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { | | | | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 | /* * Extend the package configuration... * We cannot assume that the encodings are initialized, therefore * store the value as-is in a byte array. See Bug [9b2e636361]. */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value))); } /* * Write the changes back into the overall database. */ Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); /* * Now create the interface command for retrieval of the package * information. */ Tcl_DStringInit(&cmdName); TclDStringAppendLiteral(&cmdName, "::"); Tcl_DStringAppend(&cmdName, pkgName, -1); /* * The incomplete command name is the name of the namespace to place it * in. */ if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL, |
︙ | ︙ | |||
195 196 197 198 199 200 201 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; | | | 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { QCCD *cdPtr = (QCCD *)clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; Tcl_Size m, n = 0; static const char *const subcmdStrings[] = { "get", "list", NULL }; enum subcmds { CFG_GET, CFG_LIST } index; Tcl_DString conv; |
︙ | ︙ | |||
223 224 225 226 227 228 229 | if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK || pkgDict == NULL) { /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ | | | | 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 | if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK || pkgDict == NULL) { /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1)); Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE", TclGetString(pkgName), NULL); return TCL_ERROR; } switch (index) { case CFG_GET: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "key"); return TCL_ERROR; } if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG", TclGetString(objv[2]), NULL); return TCL_ERROR; } if (cdPtr->encoding) { venc = Tcl_GetEncoding(interp, cdPtr->encoding); |
︙ | ︙ | |||
275 276 277 278 279 280 281 | } Tcl_DictObjSize(interp, pkgDict, &m); listPtr = Tcl_NewListObj(m, NULL); if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 | } Tcl_DictObjSize(interp, pkgDict, &m); listPtr = Tcl_NewListObj(m, NULL); if (!listPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "insufficient memory to create list", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } if (m) { Tcl_DictSearch s; Tcl_Obj *key; |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
1743 1744 1745 1746 1747 1748 1749 | EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 650 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, | | | | | | 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 | EXTERN int * Tcl_UtfToUniCharDString(const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 649 */ EXTERN unsigned char * TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 650 */ EXTERN unsigned char * Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 651 */ EXTERN char * Tcl_GetStringFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */ EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 653 */ EXTERN unsigned char * Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 654 */ EXTERN int Tcl_UtfCharComplete(const char *src, Tcl_Size length); /* 655 */ EXTERN const char * Tcl_UtfNext(const char *src); /* 656 */ EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 657 */ |
︙ | ︙ | |||
1778 1779 1780 1781 1782 1783 1784 | Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 660 */ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); /* 661 */ EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, | | | | | | | | | 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 | Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 660 */ EXTERN int Tcl_AsyncMarkFromSignal(Tcl_AsyncHandler async, int sigNumber); /* 661 */ EXTERN int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 662 */ EXTERN int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 663 */ EXTERN int Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr); /* 664 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 665 */ EXTERN void Tcl_SplitPath(const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 666 */ EXTERN Tcl_Obj * Tcl_FSSplitPath(Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 667 */ EXTERN int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 668 */ EXTERN Tcl_Size Tcl_UniCharLen(const int *uniStr); /* 669 */ EXTERN Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length); /* 670 */ EXTERN Tcl_Size Tcl_GetCharLength(Tcl_Obj *objPtr); |
︙ | ︙ | |||
1838 1839 1840 1841 1842 1843 1844 | EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 679 */ EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, | | | | > > | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 | EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 679 */ EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]); /* 680 */ EXTERN int Tcl_GetNumberFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 681 */ EXTERN int Tcl_GetNumber(Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN Tcl_Size Tcl_GetEncodingNulLength(Tcl_Encoding encoding); /* 684 */ EXTERN int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 685 */ EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); /* 686 */ EXTERN int Tcl_GetSizeIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* Slot 687 is reserved */ /* 688 */ EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; |
︙ | ︙ | |||
2522 2523 2524 2525 2526 2527 2528 | int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */ Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ | | | | | | | | | | | | | | | | 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 | int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, Tcl_Size size); /* 644 */ int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size endValue, Tcl_Size *indexPtr); /* 645 */ Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */ char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */ int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */ unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */ unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 650 */ char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 651 */ Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */ unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 653 */ int (*tcl_UtfCharComplete) (const char *src, Tcl_Size length); /* 654 */ const char * (*tcl_UtfNext) (const char *src); /* 655 */ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */ int (*tcl_UniCharIsUnicode) (int ch); /* 657 */ int (*tcl_ExternalToUtfDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 658 */ int (*tcl_UtfToExternalDStringEx) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, Tcl_Size srcLen, int flags, Tcl_DString *dsPtr, Tcl_Size *errorLocationPtr); /* 659 */ int (*tcl_AsyncMarkFromSignal) (Tcl_AsyncHandler async, int sigNumber); /* 660 */ int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 661 */ int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *lengthPtr); /* 662 */ int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr); /* 663 */ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, Tcl_Size *argcPtr, const char ***argvPtr); /* 664 */ void (*tcl_SplitPath) (const char *path, Tcl_Size *argcPtr, const char ***argvPtr); /* 665 */ Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, Tcl_Size *lenPtr); /* 666 */ int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, Tcl_Size *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 667 */ Tcl_Size (*tcl_UniCharLen) (const int *uniStr); /* 668 */ Tcl_Size (*tcl_NumUtfChars) (const char *src, Tcl_Size length); /* 669 */ Tcl_Size (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 670 */ const char * (*tcl_UtfAtIndex) (const char *src, Tcl_Size index); /* 671 */ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, Tcl_Size first, Tcl_Size last); /* 672 */ int (*tcl_GetUniChar) (Tcl_Obj *objPtr, Tcl_Size index); /* 673 */ int (*tcl_GetBool) (Tcl_Interp *interp, const char *src, int flags, char *charPtr); /* 674 */ int (*tcl_GetBoolFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, char *charPtr); /* 675 */ Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, ptrdiff_t objc, Tcl_Obj *const objv[]); /* 679 */ int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ int (*tcl_GetSizeIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *sizePtr); /* 686 */ void (*reserved687)(void); void (*tclUnusedStubEntry) (void); /* 688 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus |
︙ | ︙ | |||
3885 3886 3887 3888 3889 3890 3891 | (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #define Tcl_GetWideUIntFromObj \ (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ | > | | 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 | (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #define Tcl_GetWideUIntFromObj \ (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ #define Tcl_GetSizeIntFromObj \ (tclStubsPtr->tcl_GetSizeIntFromObj) /* 686 */ /* Slot 687 is reserved */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 688 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ |
︙ | ︙ | |||
3935 3936 3937 3938 3939 3940 3941 | #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) #define Tcl_AddErrorInfo(interp, message) \ | | | | 3938 3939 3940 3941 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 | #define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData) #define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData) #define Tcl_UpVar(interp, frameName, varName, localName, flags) \ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags) #define Tcl_AddErrorInfo(interp, message) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1)) #define Tcl_AddObjErrorInfo(interp, message, length) \ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length)) #define Tcl_Eval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, 0) #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL) #define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) #define Tcl_SetResult(interp, result, freeProc) \ do { \ const char *__result = result; \ Tcl_FreeProc *__freeProc = freeProc; \ Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \ if (__freeProc == TCL_DYNAMIC) { \ Tcl_Free((char *)__result); \ } else { \ (*__freeProc)((char *)__result); \ } \ } \ |
︙ | ︙ | |||
4034 4035 4036 4037 4038 4039 4040 | #undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) # if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ | | | | | | | | | | | 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 4050 4051 4052 4053 4054 4055 4056 4057 4058 4059 4060 4061 4062 4063 4064 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 | #undef TclGetByteArrayFromObj #undef Tcl_GetByteArrayFromObj #if defined(USE_TCL_STUBS) # if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) # endif #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #if TCL_MAJOR_VERSION > 8 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #else #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \ tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif #else #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetBoolean(interp, src, boolPtr) \ ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) #define Tcl_GetStringFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))) #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \ (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \ (Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr))) #endif #ifdef TCL_MEM_DEBUG # undef Tcl_Alloc # define Tcl_Alloc(x) \ (Tcl_DbCkalloc((x), __FILE__, __LINE__)) # undef Tcl_Free |
︙ | ︙ | |||
4164 4165 4166 4167 4168 4169 4170 | : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ | | | | | | | | | | | | | | | | 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 | : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) # undef Tcl_ListObjGetElements # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # undef Tcl_ListObjLength # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ ? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ : tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # undef Tcl_DictObjSize # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ ? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ : tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # undef Tcl_SplitList # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ ? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ : tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_SplitPath # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ ? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ : tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ ? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ : tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ ? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ : tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) #else # define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \ ? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \ : (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_Char16ToUtfDString) # define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \ ? (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToUniCharDString \ : (wchar_t *(*)(const char *, Tcl_Size, Tcl_DString *))Tcl_UtfToChar16DString) # define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToUniChar \ : (Tcl_Size (*)(const char *, wchar_t *))Tcl_UtfToChar16) # define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \ ? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \ : (Tcl_Size (*)(wchar_t *))Tcl_Char16Len) #if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED) # define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \ : (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr))) # define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \ ? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \ : (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr))) # define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \ ? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \ : (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ ? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \ : (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \ ? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \ : (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \ ? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \ : (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \ ? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \ : (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) #endif /* !defined(BUILD_tcl) */ #endif /* * Deprecated Tcl procedures: */ |
︙ | ︙ |
Changes to generic/tclDictObj.c.
︙ | ︙ | |||
485 486 487 488 489 490 491 | Tcl_Obj *dictPtr) { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; | | | | 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 | Tcl_Obj *dictPtr) { #define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Dict *dict; ChainEntry *cPtr; Tcl_Obj *keyPtr, *valuePtr; Tcl_Size i, length; TCL_HASH_TYPE bytesNeeded = 0; const char *elem; char *dst; /* * This field is the most useful one in the whole hash structure, and it * is not exposed by any API function... */ Tcl_Size numElems; DictGetInternalRep(dictPtr, dict); assert (dict != NULL); numElems = dict->table.numEntries * 2; |
︙ | ︙ | |||
600 601 602 603 604 605 606 | /* * Since lists and dictionaries have very closely-related string * representations (i.e. the same parsing code) we can safely special-case * the conversion from lists to dictionaries. */ if (TclHasInternalRep(objPtr, &tclListType.objType)) { | | | 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 | /* * Since lists and dictionaries have very closely-related string * representations (i.e. the same parsing code) we can safely special-case * the conversion from lists to dictionaries. */ if (TclHasInternalRep(objPtr, &tclListType.objType)) { Tcl_Size objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ TclListObjGetElementsM(NULL, objPtr, &objc, &objv); if (objc & 1) { goto missingValue; } |
︙ | ︙ | |||
630 631 632 633 634 635 636 | TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { | | | | 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 | TclDecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ } } else { Tcl_Size length; const char *nextElem = Tcl_GetStringFromObj(objPtr, &length); const char *limit = (nextElem + length); while (nextElem < limit) { Tcl_Obj *keyPtr, *valuePtr; const char *elemStart; Tcl_Size elemSize; int literal; if (TclFindDictElement(interp, nextElem, (limit - nextElem), &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) { goto errorInFindDictElement; } if (elemStart == limit) { |
︙ | ︙ | |||
713 714 715 716 717 718 719 | dict->refCount = 1; DictSetInternalRep(objPtr, dict); return TCL_OK; missingValue: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 | dict->refCount = 1; DictSetInternalRep(objPtr, dict); return TCL_OK; missingValue: if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "missing value to go with key", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL); } errorInFindDictElement: DeleteChainTable(dict); Tcl_Free(dict); return TCL_ERROR; } |
︙ | ︙ | |||
775 776 777 778 779 780 781 | *---------------------------------------------------------------------- */ Tcl_Obj * TclTraceDictPath( Tcl_Interp *interp, Tcl_Obj *dictPtr, | | | | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 | *---------------------------------------------------------------------- */ Tcl_Obj * TclTraceDictPath( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], int flags) { Dict *dict, *newDict; Tcl_Size i; DictGetInternalRep(dictPtr, dict); if (dict == NULL) { if (SetDictFromAny(interp, dictPtr) != TCL_OK) { return NULL; } DictGetInternalRep(dictPtr, dict); |
︙ | ︙ | |||
1064 1065 1066 1067 1068 1069 1070 | */ #undef Tcl_DictObjSize int Tcl_DictObjSize( Tcl_Interp *interp, Tcl_Obj *dictPtr, | | | 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 | */ #undef Tcl_DictObjSize int Tcl_DictObjSize( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size *sizePtr) { Dict *dict; dict = GetDictFromObj(interp, dictPtr); if (dict == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1277 1278 1279 1280 1281 1282 1283 | *---------------------------------------------------------------------- */ int Tcl_DictObjPutKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, | | | | 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 | *---------------------------------------------------------------------- */ int Tcl_DictObjPutKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const keyv[], Tcl_Obj *valuePtr) { Dict *dict; Tcl_HashEntry *hPtr; int isNew; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjPutKeyList"); } if (keyc < 1) { Tcl_Panic("%s called with empty key list", "Tcl_DictObjPutKeyList"); } dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE); if (dictPtr == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1338 1339 1340 1341 1342 1343 1344 | *---------------------------------------------------------------------- */ int Tcl_DictObjRemoveKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, | | | 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 | *---------------------------------------------------------------------- */ int Tcl_DictObjRemoveKeyList( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size keyc, Tcl_Obj *const keyv[]) { Dict *dict; if (Tcl_IsShared(dictPtr)) { Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList"); } |
︙ | ︙ | |||
2021 2022 2023 2024 2025 2026 2027 | DictSizeCmd( TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int result; | | | 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 | DictSizeCmd( TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { int result; Tcl_Size size; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary"); return TCL_ERROR; } result = Tcl_DictObjSize(interp, objv[1], &size); if (result == TCL_OK) { |
︙ | ︙ | |||
2115 2116 2117 2118 2119 2120 2121 | dict = GetDictFromObj(interp, objv[1]); if (dict == NULL) { return TCL_ERROR; } statsStr = Tcl_HashStats(&dict->table); | | | 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 | dict = GetDictFromObj(interp, objv[1]); if (dict == NULL) { return TCL_ERROR; } statsStr = Tcl_HashStats(&dict->table); Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1)); Tcl_Free(statsStr); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
2459 2460 2461 2462 2463 2464 2465 | int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch *searchPtr; | | | | 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 | int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj, *valueObj; Tcl_DictSearch *searchPtr; Tcl_Size varc; int done; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "{keyVarName valueVarName} dictionary script"); return TCL_ERROR; } /* * Parse arguments. */ if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL); return TCL_ERROR; } searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch)); if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, searchPtr); |
︙ | ︙ | |||
2654 2655 2656 2657 2658 2659 2660 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj **varv, *keyObj, *valueObj; DictMapStorage *storagePtr; | | | | 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj **varv, *keyObj, *valueObj; DictMapStorage *storagePtr; Tcl_Size varc; int done; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "{keyVarName valueVarName} dictionary script"); return TCL_ERROR; } /* * Parse arguments. */ if (TclListObjGetElementsM(interp, objv[1], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL); return TCL_ERROR; } storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage)); if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj, &valueObj, &done) != TCL_OK) { TclStackFree(interp, storagePtr); |
︙ | ︙ | |||
2994 2995 2996 2997 2998 2999 3000 | enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES } index; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; int done, result, satisfied; | | | 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 | enum FilterTypes { FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES } index; Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj; Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj; Tcl_DictSearch search; int done, result, satisfied; Tcl_Size varc; const char *pattern; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType", |
︙ | ︙ | |||
3112 3113 3114 3115 3116 3117 3118 | */ if (TclListObjGetElementsM(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 | */ if (TclListObjGetElementsM(interp, objv[3], &varc, &varv) != TCL_OK) { return TCL_ERROR; } if (varc != 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "must have exactly two variable names", -1)); Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL); return TCL_ERROR; } keyVarObj = varv[0]; valueVarObj = varv[1]; scriptObj = objv[4]; |
︙ | ︙ | |||
3272 3273 3274 3275 3276 3277 3278 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i; | | | 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; Tcl_Obj *dictPtr, *objPtr; int i; Tcl_Size dummy; if (objc < 5 || !(objc & 1)) { Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key varName ?key varName ...? script"); return TCL_ERROR; } |
︙ | ︙ | |||
3325 3326 3327 3328 3329 3330 3331 | FinalizeDictUpdate( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; | | | 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 | FinalizeDictUpdate( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj *dictPtr, *objPtr, **objv; Tcl_InterpState state; Tcl_Size i, objc; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *argsObj = (Tcl_Obj *)data[1]; /* * ErrorInfo handling. */ |
︙ | ︙ | |||
3475 3476 3477 3478 3479 3480 3481 | static int FinalizeDictWith( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj **pathv; | | | 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 | static int FinalizeDictWith( void *data[], Tcl_Interp *interp, int result) { Tcl_Obj **pathv; Tcl_Size pathc; Tcl_InterpState state; Tcl_Obj *varName = (Tcl_Obj *)data[0]; Tcl_Obj *keysPtr = (Tcl_Obj *)data[1]; Tcl_Obj *pathPtr = (Tcl_Obj *)data[2]; Var *varPtr, *arrayPtr; if (result == TCL_ERROR) { |
︙ | ︙ | |||
3552 3553 3554 3555 3556 3557 3558 | *---------------------------------------------------------------------- */ Tcl_Obj * TclDictWithInit( Tcl_Interp *interp, Tcl_Obj *dictPtr, | | | | 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 | *---------------------------------------------------------------------- */ Tcl_Obj * TclDictWithInit( Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Size pathc, Tcl_Obj *const pathv[]) { Tcl_DictSearch s; Tcl_Obj *keyPtr, *valPtr, *keysPtr; int done; if (pathc > 0) { dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv, DICT_PATH_READ); if (dictPtr == NULL) { return NULL; } } |
︙ | ︙ | |||
3639 3640 3641 3642 3643 3644 3645 | int pathc, /* The number of elements in the path into the * dictionary. */ Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */ Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is * the result value from TclDictWithInit. */ { Tcl_Obj *dictPtr, *leafPtr, *valPtr; | | | 3639 3640 3641 3642 3643 3644 3645 3646 3647 3648 3649 3650 3651 3652 3653 | int pathc, /* The number of elements in the path into the * dictionary. */ Tcl_Obj *const pathv[], /* The elements of the path to the subdict. */ Tcl_Obj *keysPtr) /* List of keys to be synchronized. This is * the result value from TclDictWithInit. */ { Tcl_Obj *dictPtr, *leafPtr, *valPtr; Tcl_Size i, allocdict, keyc; Tcl_Obj **keyv; /* * If the dictionary variable doesn't exist, drop everything silently. */ dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, |
︙ | ︙ |
Changes to generic/tclDisassemble.c.
︙ | ︙ | |||
24 25 26 27 28 29 30 | static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr); static Tcl_Obj * DisassembleByteCodeObj(Tcl_Obj *objPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void GetLocationInformation(Proc *procPtr, Tcl_Obj **fileObjPtr, int *linePtr); static void PrintSourceToObj(Tcl_Obj *appendObj, | | | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr); static Tcl_Obj * DisassembleByteCodeObj(Tcl_Obj *objPtr); static int FormatInstruction(ByteCode *codePtr, const unsigned char *pc, Tcl_Obj *bufferObj); static void GetLocationInformation(Proc *procPtr, Tcl_Obj **fileObjPtr, int *linePtr); static void PrintSourceToObj(Tcl_Obj *appendObj, const char *stringPtr, Tcl_Size maxChars); static void UpdateStringOfInstName(Tcl_Obj *objPtr); /* * The structure below defines an instruction name Tcl object to allow * reporting of inner contexts in errorstack without string allocation. */ |
︙ | ︙ | |||
190 191 192 193 194 195 196 | */ void TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ | | | | 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 | */ void TclPrintObject( FILE *outFile, /* The file to print the source to. */ Tcl_Obj *objPtr, /* Points to the Tcl object whose string * representation should be printed. */ Tcl_Size maxChars) /* Maximum number of chars to print. */ { char *bytes; Tcl_Size length; bytes = Tcl_GetStringFromObj(objPtr, &length); TclPrintSource(outFile, bytes, TclMin(length, maxChars)); } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
221 222 223 224 225 226 227 | *---------------------------------------------------------------------- */ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ | | | 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 | *---------------------------------------------------------------------- */ void TclPrintSource( FILE *outFile, /* The file to print the source to. */ const char *stringPtr, /* The string to print. */ Tcl_Size maxChars) /* Maximum number of chars to print. */ { Tcl_Obj *bufferObj; TclNewObj(bufferObj); PrintSourceToObj(bufferObj, stringPtr, maxChars); fprintf(outFile, "%s", TclGetString(bufferObj)); Tcl_DecrRefCount(bufferObj); |
︙ | ︙ | |||
276 277 278 279 280 281 282 | /* * Print header lines describing the ByteCode. */ Tcl_AppendPrintfToObj(bufferObj, "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | /* * Print header lines describing the ByteCode. */ Tcl_AppendPrintfToObj(bufferObj, "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); Tcl_AppendToObj(bufferObj, " Source ", -1); PrintSourceToObj(bufferObj, codePtr->source, TclMin(codePtr->numSrcBytes, 55)); GetLocationInformation(codePtr->procPtr, &fileObj, &line); if (line >= 0 && fileObj != NULL) { Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d", TclGetString(fileObj), line); } |
︙ | ︙ | |||
335 336 337 338 339 340 341 | (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "", (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "", (localPtr->flags & VAR_RESOLVED) ? ", resolved" : ""); if (TclIsVarTemporary(localPtr)) { | | | 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 | (localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar", (localPtr->flags & VAR_ARRAY) ? ", array" : "", (localPtr->flags & VAR_LINK) ? ", link" : "", (localPtr->flags & VAR_ARGUMENT) ? ", arg" : "", (localPtr->flags & VAR_TEMPORARY) ? ", temp" : "", (localPtr->flags & VAR_RESOLVED) ? ", resolved" : ""); if (TclIsVarTemporary(localPtr)) { Tcl_AppendToObj(bufferObj, "\n", -1); } else { Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n", localPtr->name); } localPtr = localPtr->nextPtr; } } |
︙ | ︙ | |||
385 386 387 388 389 390 391 | * If there were no commands (e.g., an expression or an empty string was * compiled), just print all instructions and return. */ if (numCmds == 0) { pc = codeStart; while (pc < codeLimit) { | | | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 | * If there were no commands (e.g., an expression or an empty string was * compiled), just print all instructions and return. */ if (numCmds == 0) { pc = codeStart; while (pc < codeLimit) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } return bufferObj; } /* * Print table showing the code offset, source offset, and source length |
︙ | ︙ | |||
447 448 449 450 451 452 453 | Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { | | | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d", ((i % 2)? " " : "\n "), (i+1), codeOffset, (codeOffset + codeLen - 1), srcOffset, (srcOffset + srcLen - 1)); } if (numCmds > 0) { Tcl_AppendToObj(bufferObj, "\n", -1); } /* * Print each instruction. If the instruction corresponds to the start of * a command, print the command's source. Note that we don't need the code * length here. */ |
︙ | ︙ | |||
496 497 498 499 500 501 502 | } /* * Print instructions before command i. */ while ((pc-codeStart) < codeOffset) { | | | | | 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | } /* * Print instructions before command i. */ while ((pc-codeStart) < codeOffset) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } Tcl_AppendPrintfToObj(bufferObj, " Command %d: ", i+1); PrintSourceToObj(bufferObj, (codePtr->source + srcOffset), TclMin(srcLen, 55)); Tcl_AppendToObj(bufferObj, "\n", -1); } if (pc < codeLimit) { /* * Print instructions after the last command. */ while (pc < codeLimit) { Tcl_AppendToObj(bufferObj, " ", -1); pc += FormatInstruction(codePtr, pc, bufferObj); } } return bufferObj; } /* |
︙ | ︙ | |||
648 649 650 651 652 653 654 | case OPERAND_NONE: default: break; } } if (suffixObj) { const char *bytes; | | | | | | | 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 | case OPERAND_NONE: default: break; } } if (suffixObj) { const char *bytes; Tcl_Size length; Tcl_AppendToObj(bufferObj, "\t# ", -1); bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length); PrintSourceToObj(bufferObj, bytes, TclMin(length, 40)); } else if (suffixBuffer[0]) { Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer); if (suffixSrc) { PrintSourceToObj(bufferObj, suffixSrc, 40); } } Tcl_AppendToObj(bufferObj, "\n", -1); if (auxPtr && auxPtr->type->printProc) { Tcl_AppendToObj(bufferObj, "\t\t[", -1); auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr, pcOffset); Tcl_AppendToObj(bufferObj, "]\n", -1); } return numBytes; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
686 687 688 689 690 691 692 | Tcl_Obj * TclGetInnerContext( Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr) { | | | 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 | Tcl_Obj * TclGetInnerContext( Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr) { Tcl_Size objc = 0; Tcl_Obj *result; Interp *iPtr = (Interp *) interp; switch (*pc) { case INST_STR_LEN: case INST_LNOT: case INST_BITNOT: |
︙ | ︙ | |||
755 756 757 758 759 760 761 | result = iPtr->innerContext; if (Tcl_IsShared(result)) { Tcl_DecrRefCount(result); iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); Tcl_IncrRefCount(result); } else { | | | 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 | result = iPtr->innerContext; if (Tcl_IsShared(result)) { Tcl_DecrRefCount(result); iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL); Tcl_IncrRefCount(result); } else { Tcl_Size len; /* * Reset while keeping the list internalrep as much as possible. */ TclListObjLengthM(interp, result, &len); Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); |
︙ | ︙ | |||
856 857 858 859 860 861 862 | *---------------------------------------------------------------------- */ static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ | | | | | | | | | | | | | | 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 | *---------------------------------------------------------------------- */ static void PrintSourceToObj( Tcl_Obj *appendObj, /* The object to print the source to. */ const char *stringPtr, /* The string to print. */ Tcl_Size maxChars) /* Maximum number of chars to print. */ { const char *p; Tcl_Size i = 0, len; if (stringPtr == NULL) { Tcl_AppendToObj(appendObj, "\"\"", -1); return; } Tcl_AppendToObj(appendObj, "\"", -1); p = stringPtr; for (; (*p != '\0') && (i < maxChars); p+=len) { int ucs4; len = TclUtfToUCS4(p, &ucs4); switch (ucs4) { case '"': Tcl_AppendToObj(appendObj, "\\\"", -1); i += 2; continue; case '\f': Tcl_AppendToObj(appendObj, "\\f", -1); i += 2; continue; case '\n': Tcl_AppendToObj(appendObj, "\\n", -1); i += 2; continue; case '\r': Tcl_AppendToObj(appendObj, "\\r", -1); i += 2; continue; case '\t': Tcl_AppendToObj(appendObj, "\\t", -1); i += 2; continue; case '\v': Tcl_AppendToObj(appendObj, "\\v", -1); i += 2; continue; default: if (ucs4 > 0xFFFF) { Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ucs4); i += 10; } else if (ucs4 < 0x20 || ucs4 >= 0x7F) { Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ucs4); i += 6; } else { Tcl_AppendPrintfToObj(appendObj, "%c", ucs4); i++; } continue; } } if (*p != '\0') { Tcl_AppendToObj(appendObj, "...", -1); } Tcl_AppendToObj(appendObj, "\"", -1); } /* *---------------------------------------------------------------------- * * DisassembleByteCodeAsDicts -- * |
︙ | ︙ | |||
968 969 970 971 972 973 974 | for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) { Tcl_Obj *descriptor[2]; TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], | | | | | | | | | | 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 | for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) { Tcl_Obj *descriptor[2]; TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("scalar", -1)); } if (localPtr->flags & VAR_ARRAY) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("array", -1)); } if (localPtr->flags & VAR_LINK) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("link", -1)); } if (localPtr->flags & VAR_ARGUMENT) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("arg", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("temp", -1)); } if (localPtr->flags & VAR_RESOLVED) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("resolved", -1)); } if (localPtr->flags & VAR_TEMPORARY) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(1, descriptor)); } else { descriptor[1] = Tcl_NewStringObj(localPtr->name, -1); Tcl_ListObjAppendElement(NULL, variables, Tcl_NewListObj(2, descriptor)); } } } /* * Get the instructions from the bytecode. */ TclNewObj(instructions); for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){ const InstructionDesc *instDesc = &tclInstructionTable[*pc]; int address = pc - codePtr->codeStart; TclNewObj(inst); Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( instDesc->name, -1)); opnd = pc + 1; for (i=0 ; i<instDesc->numOperands ; i++) { switch (instDesc->opTypes[i]) { case OPERAND_INT1: val = TclGetInt1AtPtr(opnd); opnd += 1; goto formatNumber; |
︙ | ︙ | |||
1078 1079 1080 1081 1082 1083 1084 | val = TclGetInt4AtPtr(opnd); opnd += 4; if (val >= -1) { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".%d", val)); } else if (val == -2) { Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( | | | 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | val = TclGetInt4AtPtr(opnd); opnd += 4; if (val >= -1) { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".%d", val)); } else if (val == -2) { Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( ".end", -1)); } else { Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf( ".end-%d", -2-val)); } break; case OPERAND_AUX4: val = TclGetInt4AtPtr(opnd); |
︙ | ︙ | |||
1111 1112 1113 1114 1115 1116 1117 | /* * Get the auxiliary data from the bytecode. */ TclNewObj(aux); for (i=0 ; i<(int)codePtr->numAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; | | | | 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 | /* * Get the auxiliary data from the bytecode. */ TclNewObj(aux); for (i=0 ; i<(int)codePtr->numAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); if (auxData->type->disassembleProc) { Tcl_Obj *desc; TclNewObj(desc); Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc); auxDesc = desc; auxData->type->disassembleProc(auxData->clientData, auxDesc, codePtr, 0); } else if (auxData->type->printProc) { Tcl_Obj *desc; TclNewObj(desc); |
︙ | ︙ | |||
1184 1185 1186 1187 1188 1189 1190 | Tcl_Obj *cmd; codeOffset += Decode(codeOffPtr); codeLength = Decode(codeLenPtr); sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); TclNewObj(cmd); | | | | | | | | | | | | | | | | | | | | 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 | Tcl_Obj *cmd; codeOffset += Decode(codeOffPtr); codeLength = Decode(codeLenPtr); sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); TclNewObj(cmd); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1), Tcl_NewWideIntObj(codeOffset)); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1), Tcl_NewWideIntObj(codeOffset + codeLength - 1)); /* * Convert byte offsets to character offsets; important if multibyte * characters are present in the source! */ Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1), Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset))); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1), Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source, sourceOffset + sourceLength - 1))); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength)); Tcl_ListObjAppendElement(NULL, commands, cmd); } #undef Decode /* * Get the source file and line number information from the CmdFrame * system if it is available. */ GetLocationInformation(codePtr->procPtr, &file, &line); /* * Build the overall result. */ TclNewObj(description); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1), literals); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1), variables); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1), instructions); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1), commands); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1), Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1), Tcl_NewStringObj(codePtr->nsPtr->fullName, -1)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1), Tcl_NewWideIntObj(codePtr->maxStackDepth)); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1), Tcl_NewWideIntObj(codePtr->maxExceptDepth)); if (line >= 0) { Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("initiallinenumber", -1), Tcl_NewWideIntObj(line)); } if (file) { Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("sourcefile", -1), file); } return description; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1406 1407 1408 1409 1410 1411 1412 | Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "CONSRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 | Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "CONSRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of constructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } /* * Compile if necessary. |
︙ | ︙ | |||
1471 1472 1473 1474 1475 1476 1477 | Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "DESRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 | Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "DESRUCTOR", NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod(methodPtr); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of destructor", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } /* * Compile if necessary. |
︙ | ︙ | |||
1561 1562 1563 1564 1565 1566 1567 | Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[3]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 | Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD", TclGetString(objv[3]), NULL); return TCL_ERROR; } procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr)); if (procPtr == NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "body not available for this kind of method", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "METHODTYPE", NULL); return TCL_ERROR; } if (!TclHasInternalRep(procPtr->bodyPtr, &tclByteCodeType)) { Command cmd; |
︙ | ︙ | |||
1598 1599 1600 1601 1602 1603 1604 | * Do the actual disassembly. */ ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr); if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 | * Do the actual disassembly. */ ByteCodeGetInternalRep(codeObjPtr, &tclByteCodeType, codePtr); if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "may not disassemble prebuilt bytecode", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE", "BYTECODE", NULL); return TCL_ERROR; } if (clientData) { Tcl_SetObjResult(interp, DisassembleByteCodeAsDicts(codeObjPtr)); |
︙ | ︙ |
Changes to generic/tclEncoding.c.
︙ | ︙ | |||
1411 1412 1413 1414 1415 1416 1417 | dstCharsPtr = &dstChars; flags &= ~TCL_ENCODING_CHAR_LIMIT; } else if (charLimited) { maxChars = *dstCharsPtr; } if (!noTerminate) { | | | | | 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 | dstCharsPtr = &dstChars; flags &= ~TCL_ENCODING_CHAR_LIMIT; } else if (charLimited) { maxChars = *dstCharsPtr; } if (!noTerminate) { if (dstLen < 1) { return TCL_CONVERT_NOSPACE; } /* * If there are any null characters in the middle of the buffer, * they will converted to the UTF-8 null character (\xC0\x80). To get * the actual \0 at the end of the destination buffer, we need to * append it manually. First make room for it... */ |
︙ | ︙ | |||
1608 1609 1610 1611 1612 1613 1614 | * of a multibyte character * In both cases we have to grow buffer, move the input source pointer * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); | | | | 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 | * of a multibyte character * In both cases we have to grow buffer, move the input source pointer * and loop. Otherwise, return the result we got. */ if ((result != TCL_CONVERT_NOSPACE) && !(result == TCL_CONVERT_MULTIBYTE && (flags & TCL_ENCODING_END))) { Tcl_Size nBytesProcessed = (src - srcStart); Tcl_Size i = soFar + encodingPtr->nullSize - 1; /* Loop as DStringSetLength only stores one nul byte at a time */ while (i >= soFar) { Tcl_DStringSetLength(dstPtr, i--); } if (errorLocPtr) { /* * Do not write error message into interpreter if caller * wants to know error location. */ |
︙ | ︙ |
Changes to generic/tclEnsemble.c.
︙ | ︙ | |||
102 103 104 105 106 107 108 | /* * The internal rep for caching ensemble subcommand lookups and spelling * corrections. */ typedef struct { | | | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | /* * The internal rep for caching ensemble subcommand lookups and spelling * corrections. */ typedef struct { Tcl_Size epoch; /* Used to confirm when the data in this * really structure matches up with the * ensemble. */ Command *token; /* Reference to the command for which this * structure is a cache of the resolution. */ Tcl_Obj *fix; /* Corrected spelling, if needed. */ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash * table. */ } EnsembleCmdRep; static inline Tcl_Obj * NewNsObj( Tcl_Namespace *namespacePtr) { Namespace *nsPtr = (Namespace *) namespacePtr; if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) { return Tcl_NewStringObj("::", 2); } return Tcl_NewStringObj(nsPtr->fullName, -1); } /* *---------------------------------------------------------------------- * * TclNamespaceEnsembleCmd -- * |
︙ | ︙ | |||
185 186 187 188 189 190 191 | "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case ENS_CREATE: { const char *name; | | | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 | "subcommand", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case ENS_CREATE: { const char *name; Tcl_Size len; int allocatedMapFlag = 0; /* * Defaults */ Tcl_Obj *subcmdObj = NULL; Tcl_Obj *mapObj = NULL; int permitPrefix = 1; |
︙ | ︙ | |||
285 286 287 288 289 290 291 | Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " | | | 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 | Tcl_DecrRefCount(mapObj); } return TCL_ERROR; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } if (allocatedMapFlag) { |
︙ | ︙ | |||
456 457 458 459 460 461 462 | Tcl_Obj *resultObj, *tmpObj = NULL; /* silence gcc 4 warning */ int flags = 0; /* silence gcc 4 warning */ TclNewObj(resultObj); /* -map option */ Tcl_ListObjAppendElement(NULL, resultObj, | | | | | | 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | Tcl_Obj *resultObj, *tmpObj = NULL; /* silence gcc 4 warning */ int flags = 0; /* silence gcc 4 warning */ TclNewObj(resultObj); /* -map option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1)); Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -namespace option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE], -1)); namespacePtr = NULL; /* silence gcc 4 warning */ Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr); Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr)); /* -parameters option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1)); Tcl_GetEnsembleParameterList(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -prefix option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1)); Tcl_GetEnsembleFlags(NULL, token, &flags); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX)); /* -subcommands option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1)); Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); /* -unknown option */ Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1)); Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj); Tcl_ListObjAppendElement(NULL, resultObj, (tmpObj != NULL) ? tmpObj : Tcl_NewObj()); Tcl_SetObjResult(interp, resultObj); } else { Tcl_Size len; int allocatedMapFlag = 0; Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL, *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */ int permitPrefix, flags = 0; /* silence gcc 4 warning */ Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj); Tcl_GetEnsembleMappingDict(NULL, token, &mapObj); |
︙ | ︙ | |||
573 574 575 576 577 578 579 | Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " | | | 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 | Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; } if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "ensemble subcommand implementations " "must be non-empty lists", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "EMPTY_TARGET", NULL); Tcl_DictObjDone(&search); if (patchedDict) { Tcl_DecrRefCount(patchedDict); } goto freeMapAndError; |
︙ | ︙ | |||
621 622 623 624 625 626 627 | if (patchedDict) { allocatedMapFlag = 1; } continue; } case CONF_NAMESPACE: Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | if (patchedDict) { allocatedMapFlag = 1; } continue; } case CONF_NAMESPACE: Tcl_SetObjResult(interp, Tcl_NewStringObj( "option -namespace is read-only", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY", NULL); goto freeMapAndError; case CONF_PREFIX: if (Tcl_GetBooleanFromObj(interp, objv[1], &permitPrefix) != TCL_OK) { goto freeMapAndError; |
︙ | ︙ | |||
794 795 796 797 798 799 800 | { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 | { Command *cmdPtr = (Command *) token; EnsembleConfig *ensemblePtr; Tcl_Obj *oldList; if (cmdPtr->objProc != TclEnsembleImplementationCmd) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "command is not an ensemble", -1)); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL); return TCL_ERROR; } if (subcmdList != NULL) { Tcl_Size length; if (TclListObjLengthM(interp, subcm |