diff options
355 files changed, 4952 insertions, 3329 deletions
diff --git a/doc/Access.3 b/doc/Access.3 index 1e82e07..668e1db 100644 --- a/doc/Access.3 +++ b/doc/Access.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Access, Tcl_Stat \- check file permissions and other attributes diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3 index 36f6a20..d4bf7d5 100644 --- a/doc/AddErrInfo.3 +++ b/doc/AddErrInfo.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options diff --git a/doc/Alloc.3 b/doc/Alloc.3 index ca4f949..585704a 100644 --- a/doc/Alloc.3 +++ b/doc/Alloc.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory diff --git a/doc/AllowExc.3 b/doc/AllowExc.3 index ae595f1..2343e66 100644 --- a/doc/AllowExc.3 +++ b/doc/AllowExc.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AllowExceptions \- allow all exceptions in next script evaluation diff --git a/doc/AppInit.3 b/doc/AppInit.3 index e4ae971..3e47c1f 100644 --- a/doc/AppInit.3 +++ b/doc/AppInit.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AppInit \- perform application-specific initialization diff --git a/doc/AssocData.3 b/doc/AssocData.3 index 59c26a4..f819acb 100644 --- a/doc/AssocData.3 +++ b/doc/AssocData.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters diff --git a/doc/Async.3 b/doc/Async.3 index d02f76d..558b511 100644 --- a/doc/Async.3 +++ b/doc/Async.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events diff --git a/doc/BackgdErr.3 b/doc/BackgdErr.3 index 3116671..4ebcb60 100644 --- a/doc/BackgdErr.3 +++ b/doc/BackgdErr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurred in background processing diff --git a/doc/Backslash.3 b/doc/Backslash.3 index 8b399fc..f121c7c 100644 --- a/doc/Backslash.3 +++ b/doc/Backslash.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Backslash \- parse a backslash sequence diff --git a/doc/BoolObj.3 b/doc/BoolObj.3 index 6691140..5c8414d 100644 --- a/doc/BoolObj.3 +++ b/doc/BoolObj.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_BooleanObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve boolean value in a Tcl_Obj diff --git a/doc/ByteArrObj.3 b/doc/ByteArrObj.3 index 2921f68..a1f9330 100644 --- a/doc/ByteArrObj.3 +++ b/doc/ByteArrObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes diff --git a/doc/CallDel.3 b/doc/CallDel.3 index dec4392..766621a 100644 --- a/doc/CallDel.3 +++ b/doc/CallDel.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interpreter is deleted diff --git a/doc/Cancel.3 b/doc/Cancel.3 index 80db3a3..5d258b7 100644 --- a/doc/Cancel.3 +++ b/doc/Cancel.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Cancel 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CancelEval, Tcl_Canceled \- cancel Tcl scripts diff --git a/doc/ChnlStack.3 b/doc/ChnlStack.3 index 9ec38b4..b046cd2 100644 --- a/doc/ChnlStack.3 +++ b/doc/ChnlStack.3 @@ -3,8 +3,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH Tcl_StackChannel 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Class.3 b/doc/Class.3 index 28cea9b..7e421fe 100644 --- a/doc/Class.3 +++ b/doc/Class.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -111,7 +111,7 @@ function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR is a shared reference. .PP Instances of classes are created using \fBTcl_NewObjectInstance\fR, which -takes creates an object from any class (and which is internally called by both +creates an object from any class (and which is internally called by both the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes parameters that optionally give the name of the object and namespace to create, and which describe the arguments to pass to the class's constructor diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3 index eeae039..25b372e 100644 --- a/doc/CmdCmplt.3 +++ b/doc/CmdCmplt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CommandComplete \- Check for unmatched braces in a Tcl command diff --git a/doc/Concat.3 b/doc/Concat.3 index c38bf82..58a0fb6 100644 --- a/doc/Concat.3 +++ b/doc/Concat.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Concat \- concatenate a collection of strings diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index 57bb76e..1c5c665 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -4,8 +4,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/CrtChnlHdlr.3 b/doc/CrtChnlHdlr.3 index 1451e30..0ecd3c9 100644 --- a/doc/CrtChnlHdlr.3 +++ b/doc/CrtChnlHdlr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateChannelHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/CrtCloseHdlr.3 b/doc/CrtCloseHdlr.3 index a114f9c..bac2431 100644 --- a/doc/CrtCloseHdlr.3 +++ b/doc/CrtCloseHdlr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateCloseHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index c921999..fca64ce 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateCommand \- implement new commands in C diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3 index cbc5e9f..c1bc1fa 100644 --- a/doc/CrtFileHdlr.3 +++ b/doc/CrtFileHdlr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices (Unix only) diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3 index 1156a20..679795e 100644 --- a/doc/CrtInterp.3 +++ b/doc/CrtInterp.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpActive, Tcl_InterpDeleted \- create and delete Tcl command interpreters diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 index cdde20b..84cde65 100644 --- a/doc/CrtMathFnc.3 +++ b/doc/CrtMathFnc.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3 index faf8b74..e94c8cd 100644 --- a/doc/CrtObjCmd.3 +++ b/doc/CrtObjCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3 index 000ae58..fdcef6f 100644 --- a/doc/CrtSlave.3 +++ b/doc/CrtSlave.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3 index 2c9f90a..f3957c7 100644 --- a/doc/CrtTimerHdlr.3 +++ b/doc/CrtTimerHdlr.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler \- call a procedure at a given time diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index 3689add..239941f 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced diff --git a/doc/DString.3 b/doc/DString.3 index a85b1cf..0e571d2 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings diff --git a/doc/DetachPids.3 b/doc/DetachPids.3 index 0535cd8..39a51d3 100644 --- a/doc/DetachPids.3 +++ b/doc/DetachPids.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in background diff --git a/doc/DictObj.3 b/doc/DictObj.3 index db8f39a..90ca9e3 100644 --- a/doc/DictObj.3 +++ b/doc/DictObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/DoOneEvent.3 b/doc/DoOneEvent.3 index 9bdf926..6f08b34 100644 --- a/doc/DoOneEvent.3 +++ b/doc/DoOneEvent.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DoOneEvent \- wait for events and invoke event handlers diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3 index 27a4b8c..3e28b4d 100644 --- a/doc/DoWhenIdle.3 +++ b/doc/DoWhenIdle.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events diff --git a/doc/DoubleObj.3 b/doc/DoubleObj.3 index f811c89..4b422d4 100644 --- a/doc/DoubleObj.3 +++ b/doc/DoubleObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl values as floating-point values diff --git a/doc/DumpActiveMemory.3 b/doc/DumpActiveMemory.3 index 1f6cb46..f4d78d1 100644 --- a/doc/DumpActiveMemory.3 +++ b/doc/DumpActiveMemory.3 @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 7bcb285..1478c35 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings diff --git a/doc/Ensemble.3 b/doc/Ensemble.3 index cd69bbd..8457ddc 100644 --- a/doc/Ensemble.3 +++ b/doc/Ensemble.3 @@ -6,8 +6,8 @@ '\" '\" This documents the C API introduced in TIP#235 '\" -.so man.macros .TH Tcl_Ensemble 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleParameterList, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleParameterList, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands diff --git a/doc/Environment.3 b/doc/Environment.3 index 46262ab..85880b4 100644 --- a/doc/Environment.3 +++ b/doc/Environment.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PutEnv \- procedures to manipulate the environment @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Exit 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitThread, Tcl_FinalizeThread, Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler, Tcl_SetExitProc \- end the application or thread (and invoke exit handlers) diff --git a/doc/ExprLong.3 b/doc/ExprLong.3 index 4fa972e..1615f88 100644 --- a/doc/ExprLong.3 +++ b/doc/ExprLong.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3 index 686c1cb..35edb5f 100644 --- a/doc/ExprLongObj.3 +++ b/doc/ExprLongObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression diff --git a/doc/FileSystem.3 b/doc/FileSystem.3 index dd9eb77..6a8158c 100644 --- a/doc/FileSystem.3 +++ b/doc/FileSystem.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Filesystem 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSUnloadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_GetAccessTimeFromStat, Tcl_GetBlockSizeFromStat, Tcl_GetBlocksFromStat, Tcl_GetChangeTimeFromStat, Tcl_GetDeviceTypeFromStat, Tcl_GetFSDeviceFromStat, Tcl_GetFSInodeFromStat, Tcl_GetGroupIdFromStat, Tcl_GetLinkCountFromStat, Tcl_GetModeFromStat, Tcl_GetModificationTimeFromStat, Tcl_GetSizeFromStat, Tcl_GetUserIdFromStat, Tcl_AllocStatBuf \- procedures to interact with any filesystem diff --git a/doc/FindExec.3 b/doc/FindExec.3 index e4b4ed0..b01315c 100644 --- a/doc/FindExec.3 +++ b/doc/FindExec.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application diff --git a/doc/GetCwd.3 b/doc/GetCwd.3 index 964e237..58abcde 100755 --- a/doc/GetCwd.3 +++ b/doc/GetCwd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory diff --git a/doc/GetHostName.3 b/doc/GetHostName.3 index 28f3a4f..8aed0dc 100644 --- a/doc/GetHostName.3 +++ b/doc/GetHostName.3 @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetHostName \- get the name of the local host diff --git a/doc/GetIndex.3 b/doc/GetIndex.3 index d32561a..fc6f40b 100644 --- a/doc/GetIndex.3 +++ b/doc/GetIndex.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords diff --git a/doc/GetInt.3 b/doc/GetInt.3 index f77d337..4e9d636 100644 --- a/doc/GetInt.3 +++ b/doc/GetInt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3 index 38aa976..86d1b94 100644 --- a/doc/GetOpnFl.3 +++ b/doc/GetOpnFl.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpreter (Unix only) diff --git a/doc/GetStdChan.3 b/doc/GetStdChan.3 index e76ad66..8af1e7e 100644 --- a/doc/GetStdChan.3 +++ b/doc/GetStdChan.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/GetTime.3 b/doc/GetTime.3 index f4da364..6b885ee 100644 --- a/doc/GetTime.3 +++ b/doc/GetTime.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetTime, Tcl_SetTimeProc, Tcl_QueryTimeProc \- get date and time diff --git a/doc/GetVersion.3 b/doc/GetVersion.3 index 47034d0..89f63d5 100755 --- a/doc/GetVersion.3 +++ b/doc/GetVersion.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_GetVersion \- get the version of the library at runtime @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Init \- find and source initialization script diff --git a/doc/InitStubs.3 b/doc/InitStubs.3 index 4dc62c6..73c3437 100644 --- a/doc/InitStubs.3 +++ b/doc/InitStubs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_InitStubs \- initialize the Tcl stubs mechanism diff --git a/doc/IntObj.3 b/doc/IntObj.3 index 4b7b8a6..d42b44a 100644 --- a/doc/IntObj.3 +++ b/doc/IntObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers diff --git a/doc/Interp.3 b/doc/Interp.3 index d908057..b639add 100644 --- a/doc/Interp.3 +++ b/doc/Interp.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Interp \- client-visible fields of interpreter structures diff --git a/doc/Limit.3 b/doc/Limit.3 index 2941ee8..20a2e02 100644 --- a/doc/Limit.3 +++ b/doc/Limit.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LimitAddHandler, Tcl_LimitCheck, Tcl_LimitExceeded, Tcl_LimitGetCommands, Tcl_LimitGetGranularity, Tcl_LimitGetTime, Tcl_LimitReady, Tcl_LimitRemoveHandler, Tcl_LimitSetCommands, Tcl_LimitSetGranularity, Tcl_LimitSetTime, Tcl_LimitTypeEnabled, Tcl_LimitTypeExceeded, Tcl_LimitTypeReset, Tcl_LimitTypeSet \- manage and check resource limits on interpreters diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index dc71a45..c64720b 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable diff --git a/doc/ListObj.3 b/doc/ListObj.3 index bc6917d..3af0e7e 100644 --- a/doc/ListObj.3 +++ b/doc/ListObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl values as lists @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Load 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_LoadFile, Tcl_FindSymbol \- platform-independent dynamic library loading diff --git a/doc/Method.3 b/doc/Method.3 index 2537d5e..550b64a 100644 --- a/doc/Method.3 +++ b/doc/Method.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH NRE 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts. diff --git a/doc/Namespace.3 b/doc/Namespace.3 index 2b47128..be89597 100644 --- a/doc/Namespace.3 +++ b/doc/Namespace.3 @@ -7,8 +7,8 @@ '\" Note that some of these functions do not seem to belong, but they '\" were all introduced with the same TIP (#139) '\" -.so man.macros .TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGlobalNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces diff --git a/doc/Notifier.3 b/doc/Notifier.3 index f65d580..f2976b1 100644 --- a/doc/Notifier.3 +++ b/doc/Notifier.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Notifier 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode, Tcl_ServiceModeHook, Tcl_SetNotifier \- the event queue and notifier interfaces diff --git a/doc/OOInitStubs.3 b/doc/OOInitStubs.3 new file mode 100644 index 0000000..bc42453 --- /dev/null +++ b/doc/OOInitStubs.3 @@ -0,0 +1,54 @@ +'\" +'\" Copyright (c) 2012 Donal K. Fellows +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +Tcl_OOInitStubs \- initialize library access to TclOO functionality +.SH SYNOPSIS +.nf +\fB#include <tclOO.h>\fR +.sp +const char * +\fBTcl_OOInitStubs\fR(\fIinterp\fR) +.fi +.SH ARGUMENTS +.AS Tcl_Interp *interp in +.AP Tcl_Interp *interp in +The Tcl interpreter that the TclOO API is integrated with and whose C +interface is going to be used. +.BE +.SH DESCRIPTION +.PP +When an extension library is going to use the C interface exposed by TclOO, it +should use \fBTcl_OOInitStubs\fR to initialize its access to that interface +from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in +the \fIinterp\fR that was passed into that routine as context. If the result +of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an +error message will have been left in the interpreter's result. Otherwise, the +initialization succeeded and the TclOO API may thereafter be used; the +version of the TclOO API is returned. +.PP +When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR +should be defined and your library code linked against the Tcl stub library, +or that #define symbol should \fInot\fR be defined and your library code +linked against the Tcl main library directly. +.SH "BACKWARD COMPATIBILITY NOTE" +.PP +If you are linking against the Tcl 8.5 forward compatibility package for +TclOO, \fIonly\fR the stub-enabled configuration is supported and you should +also link against the TclOO independent stub library; that library is an +integrated part of the main Tcl stub library in Tcl 8.6. +.SH KEYWORDS +stubs +.SH "SEE ALSO" +Tcl_InitStubs(3) +.\" Local variables: +.\" mode: nroff +.\" fill-column: 78 +.\" End: diff --git a/doc/Object.3 b/doc/Object.3 index 3d52f61..55451ab 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values diff --git a/doc/ObjectType.3 b/doc/ObjectType.3 index ca2c7a0..424d560 100644 --- a/doc/ObjectType.3 +++ b/doc/ObjectType.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType \- manipulate Tcl value types diff --git a/doc/OpenFileChnl.3 b/doc/OpenFileChnl.3 index 82f51ce..cca76c2 100644 --- a/doc/OpenFileChnl.3 +++ b/doc/OpenFileChnl.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_OpenFileChannel 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3 index 78ac70b..9fe2615 100644 --- a/doc/OpenTcp.3 +++ b/doc/OpenTcp.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Panic.3 b/doc/Panic.3 index 48aed2b..28d56fa 100644 --- a/doc/Panic.3 +++ b/doc/Panic.3 @@ -2,8 +2,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/ParseArgs.3 b/doc/ParseArgs.3 index 1ceafe5..df0ad33 100644 --- a/doc/ParseArgs.3 +++ b/doc/ParseArgs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ParseArgsObjv \- parse arguments according to a tabular description diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 5fd9b9c..7090dd3 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions diff --git a/doc/PkgRequire.3 b/doc/PkgRequire.3 index d54d7af..5c9fdca 100644 --- a/doc/PkgRequire.3 +++ b/doc/PkgRequire.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgRequireProc, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control diff --git a/doc/Preserve.3 b/doc/Preserve.3 index 905a31d..970bded 100644 --- a/doc/Preserve.3 +++ b/doc/Preserve.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it is being used diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3 index 99b0113..730794f 100644 --- a/doc/PrintDbl.3 +++ b/doc/PrintDbl.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_PrintDouble \- Convert floating value to string diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3 index 44888f6..387cc44 100644 --- a/doc/RecEvalObj.3 +++ b/doc/RecEvalObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RecordAndEvalObj \- save command on history list before evaluating diff --git a/doc/RecordEval.3 b/doc/RecordEval.3 index a29f974..e1625ff 100644 --- a/doc/RecordEval.3 +++ b/doc/RecordEval.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RecordAndEval \- save command on history list before evaluating diff --git a/doc/RegConfig.3 b/doc/RegConfig.3 index 063cc85..d73e3d7 100644 --- a/doc/RegConfig.3 +++ b/doc/RegConfig.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RegisterConfig 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/RegExp.3 b/doc/RegExp.3 index 882976c..63f650b 100644 --- a/doc/RegExp.3 +++ b/doc/RegExp.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegExpFromObj, Tcl_RegExpMatchObj, Tcl_RegExpExecObj, Tcl_RegExpGetInfo \- Pattern matching with regular expressions diff --git a/doc/SaveResult.3 b/doc/SaveResult.3 index 8eaf38f..557391d 100644 --- a/doc/SaveResult.3 +++ b/doc/SaveResult.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3 index 3d37f59..5bb86be 100644 --- a/doc/SetChanErr.3 +++ b/doc/SetChanErr.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetChannelError 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/SetErrno.3 b/doc/SetErrno.3 index 1735952..21648b1 100644 --- a/doc/SetErrno.3 +++ b/doc/SetErrno.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to store and retrieve error codes diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3 index e38ba2f..904d4ab 100644 --- a/doc/SetRecLmt.3 +++ b/doc/SetRecLmt.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter diff --git a/doc/SetResult.3 b/doc/SetResult.3 index bbeedf1..1f86340 100644 --- a/doc/SetResult.3 +++ b/doc/SetResult.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult, Tcl_FreeResult \- manipulate Tcl result diff --git a/doc/SetVar.3 b/doc/SetVar.3 index 0605ff2..1bef20b 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables diff --git a/doc/Signal.3 b/doc/Signal.3 index 5b12654..70b9d91 100644 --- a/doc/Signal.3 +++ b/doc/Signal.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SignalId, Tcl_SignalMsg \- Convert signal codes diff --git a/doc/Sleep.3 b/doc/Sleep.3 index 2423ba1..2d36697 100644 --- a/doc/Sleep.3 +++ b/doc/Sleep.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Sleep \- delay execution for a given number of milliseconds diff --git a/doc/SourceRCFile.3 b/doc/SourceRCFile.3 index eabc47c..0afb66b 100644 --- a/doc/SourceRCFile.3 +++ b/doc/SourceRCFile.3 @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH Tcl_SourceRCFile 3 8.3 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SourceRCFile \- source the Tcl rc file diff --git a/doc/SplitList.3 b/doc/SplitList.3 index 219dfc7..3439f2e 100644 --- a/doc/SplitList.3 +++ b/doc/SplitList.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement, Tcl_ScanCountedElement, Tcl_ConvertCountedElement \- manipulate Tcl lists diff --git a/doc/SplitPath.3 b/doc/SplitPath.3 index 3fd92ac..19cee05 100644 --- a/doc/SplitPath.3 +++ b/doc/SplitPath.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SplitPath, Tcl_JoinPath, Tcl_GetPathType \- manipulate platform-dependent file paths diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3 index fa6c32f..5700ea7 100644 --- a/doc/StaticPkg.3 +++ b/doc/StaticPkg.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_StaticPackage \- make a statically linked package available via the 'load' command diff --git a/doc/StdChannels.3 b/doc/StdChannels.3 index b5b020e..651ad7d 100644 --- a/doc/StdChannels.3 +++ b/doc/StdChannels.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/StrMatch.3 b/doc/StrMatch.3 index 5adaf6e..f9c2be3 100644 --- a/doc/StrMatch.3 +++ b/doc/StrMatch.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern diff --git a/doc/StringObj.3 b/doc/StringObj.3 index e6f9d32..d81f23d 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings diff --git a/doc/SubstObj.3 b/doc/SubstObj.3 index d5a52c3..f582c5a 100644 --- a/doc/SubstObj.3 +++ b/doc/SubstObj.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_SubstObj \- perform substitutions on Tcl values diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3 index 5a3e08a..e3a6809 100644 --- a/doc/TCL_MEM_DEBUG.3 +++ b/doc/TCL_MEM_DEBUG.3 @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl n "8.6" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME Tcl \- Tool Command Language @@ -28,7 +28,7 @@ First, the Tcl interpreter breaks the command into \fIwords\fR and performs substitutions as described below. These substitutions are performed in the same way for all commands. -The first word is used to locate a command procedure to +Secondly, the first word is used to locate a command procedure to carry out the command, then all of the words of the command are passed to the command procedure. The command procedure is free to interpret each of its words @@ -108,8 +108,8 @@ Variable substitution may take any of the following forms: \fIName\fR is the name of a scalar variable; the name is a sequence of one or more characters that are a letter, digit, underscore, or namespace separators (two or more colons). -Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, -\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . @@ -117,8 +117,8 @@ Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, the name of an element within that array. \fIName\fR must contain only letters, digits, underscores, and namespace separators, and may be an empty string. -Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\-\fB9\fR, -\fBA\fR\-\fBZ\fR and \fBa\fR\-\fBz\fR). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). Command substitutions, variable substitutions, and backslash substitutions are performed on the characters of \fIindex\fR. .TP 15 @@ -158,25 +158,25 @@ handled specially, along with the value that replaces each sequence. .RS .TP 7 \e\fBa\fR -Audible alert (bell) (0x7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -Backspace (0x8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -Form feed (0xc). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -Newline (0xa). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -Carriage-return (0xd). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -Tab (0x9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -Vertical tab (0xb). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB<newline>\fIwhiteSpace\fR . @@ -194,8 +194,9 @@ Backslash \e\fIooo\fR . The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal -value for the Unicode character that will be inserted, in the range \fI000\fR -- \fI377\fR. The parser will stop just before this range overflows, or when +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when the maximum of three digits is reached. The upper bits of the Unicode character will be 0. .TP 7 @@ -203,23 +204,27 @@ character will be 0. . The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit hexadecimal value for the Unicode character that will be inserted. The upper -bits of the Unicode character will be 0. +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a sixteen-bit hexadecimal value for the Unicode character that will be -inserted. The upper bits of the Unicode character will be 0. +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a twenty-one-bit hexadecimal value for the Unicode character that will be -inserted, in the range U+0000..U+10FFFF. The parser will stop just +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just before this range overflows, or when the maximum of eight digits is reached. The upper bits of the Unicode character will be 0. +.RS .PP -The range U+010000..U+10FFFD is reserved for the future. +The range U+010000\(enU+10FFFD is reserved for the future. +.RE .PP Backslash substitution is not performed on words enclosed in braces, except for backslash-newline as described above. diff --git a/doc/TclZlib.3 b/doc/TclZlib.3 index 854a525..c6a6417 100644 --- a/doc/TclZlib.3 +++ b/doc/TclZlib.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH TclZlib 3 8.6 Tcl "Tcl Library Procedures" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3 index 0a69835..5fd5002 100644 --- a/doc/Tcl_Main.3 +++ b/doc/Tcl_Main.3 @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications diff --git a/doc/Thread.3 b/doc/Thread.3 index ca135ee..ac5f2ba 100644 --- a/doc/Thread.3 +++ b/doc/Thread.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Threads 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support diff --git a/doc/ToUpper.3 b/doc/ToUpper.3 index d6b3006..587e76b 100644 --- a/doc/ToUpper.3 +++ b/doc/ToUpper.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_UtfToLower, Tcl_UtfToTitle \- routines for manipulating the case of Unicode characters and UTF-8 strings diff --git a/doc/TraceCmd.3 b/doc/TraceCmd.3 index 5cc1337..1244576 100644 --- a/doc/TraceCmd.3 +++ b/doc/TraceCmd.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 6201a4f..97d035b 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable diff --git a/doc/Translate.3 b/doc/Translate.3 index 55233c3..0f223e4 100644 --- a/doc/Translate.3 +++ b/doc/Translate.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3 index 6029b2d..ea6fc5b 100644 --- a/doc/UniCharIsAlpha.3 +++ b/doc/UniCharIsAlpha.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters diff --git a/doc/UpVar.3 b/doc/UpVar.3 index f1e6fe4..8e7ba08 100644 --- a/doc/UpVar.3 +++ b/doc/UpVar.3 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UpVar, Tcl_UpVar2 \- link one variable to another @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Utf 3 "8.1" Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_UniChar, Tcl_UniCharCaseMatch, Tcl_UniCharNcasecmp, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings diff --git a/doc/WrongNumArgs.3 b/doc/WrongNumArgs.3 index 15d5caf..33807d5 100644 --- a/doc/WrongNumArgs.3 +++ b/doc/WrongNumArgs.3 @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures" +.so man.macros .BS .SH NAME Tcl_WrongNumArgs \- generate standard error message for wrong number of arguments diff --git a/doc/after.n b/doc/after.n index d6181c6..e61bb88 100644 --- a/doc/after.n +++ b/doc/after.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH after n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/append.n b/doc/append.n index 034068d..4b3cfd0 100644 --- a/doc/append.n +++ b/doc/append.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH append n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/apply.n b/doc/apply.n index 9d373e1..4b730ff 100644 --- a/doc/apply.n +++ b/doc/apply.n @@ -2,8 +2,8 @@ '\" Copyright (c) 2006 Miguel Sofer '\" Copyright (c) 2006 Donal K. Fellows '\" -.so man.macros .TH apply n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/array.n b/doc/array.n index 47f9624..e253a37 100644 --- a/doc/array.n +++ b/doc/array.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH array n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/bgerror.n b/doc/bgerror.n index 16a23a3..ea8fe2a 100644 --- a/doc/bgerror.n +++ b/doc/bgerror.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH bgerror n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/binary.n b/doc/binary.n index cbbebd1..014704d 100644 --- a/doc/binary.n +++ b/doc/binary.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH binary n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/break.n b/doc/break.n index cef37c6..3e4ce5f 100644 --- a/doc/break.n +++ b/doc/break.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH break n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH case n 7.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/catch.n b/doc/catch.n index 9597ccf..94fa5dd 100644 --- a/doc/catch.n +++ b/doc/catch.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH catch n "8.5" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH cd n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -3,8 +3,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH chan n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/class.n b/doc/class.n index 88d1b44..198ae41 100644 --- a/doc/class.n +++ b/doc/class.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH class n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/clock.n b/doc/clock.n index 8708029..42dca80 100644 --- a/doc/clock.n +++ b/doc/clock.n @@ -2,8 +2,8 @@ '\" Generated from file './doc/clock.dt' by tcllib/doctools with format 'nroff' '\" Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved. '\" -.so man.macros .TH "clock" n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME clock \- Obtain and manipulate dates and times diff --git a/doc/close.n b/doc/close.n index 2826d82..63da75b 100644 --- a/doc/close.n +++ b/doc/close.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH close n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/concat.n b/doc/concat.n index b079b30..575b9df 100644 --- a/doc/concat.n +++ b/doc/concat.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH concat n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/continue.n b/doc/continue.n index de2f07c..17d16b4 100644 --- a/doc/continue.n +++ b/doc/continue.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH continue n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH copy n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/coroutine.n b/doc/coroutine.n index 035d58a..c99f8d3 100644 --- a/doc/coroutine.n +++ b/doc/coroutine.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH coroutine n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH dde n 1.4 dde "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/define.n b/doc/define.n index 1c36ca3..7599ec0 100644 --- a/doc/define.n +++ b/doc/define.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH define n 0.3 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH dict n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/encoding.n b/doc/encoding.n index 5269a18..be1dc3f 100644 --- a/doc/encoding.n +++ b/doc/encoding.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH encoding n "8.1" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME encoding \- Manipulate encodings @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH eof n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/error.n b/doc/error.n index d61bd7b..a95c691 100644 --- a/doc/error.n +++ b/doc/error.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH error n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH eval n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH exec n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH exit n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH expr n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/fconfigure.n b/doc/fconfigure.n index 550d071..ca23314 100644 --- a/doc/fconfigure.n +++ b/doc/fconfigure.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fconfigure n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/fcopy.n b/doc/fcopy.n index 6a4bf1a..ec3d5c6 100644 --- a/doc/fcopy.n +++ b/doc/fcopy.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fcopy n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH file n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/fileevent.n b/doc/fileevent.n index e453748..8f6b880 100644 --- a/doc/fileevent.n +++ b/doc/fileevent.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH fileevent n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/filename.n b/doc/filename.n index d481fc9..8b8b00b 100644 --- a/doc/filename.n +++ b/doc/filename.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH filename n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/flush.n b/doc/flush.n index b8bf3e9..d266d91 100644 --- a/doc/flush.n +++ b/doc/flush.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH flush n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH for n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/foreach.n b/doc/foreach.n index fb075d3..89a11f6 100644 --- a/doc/foreach.n +++ b/doc/foreach.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH foreach n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/format.n b/doc/format.n index 23dfe60..076a820 100644 --- a/doc/format.n +++ b/doc/format.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH format n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH gets n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -.so man.macros .TH glob n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/global.n b/doc/global.n index c17c370..aa8f2e4 100644 --- a/doc/global.n +++ b/doc/global.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH global n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/history.n b/doc/history.n index ba507b4..e1f9781 100644 --- a/doc/history.n +++ b/doc/history.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH history n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "http" n 2.7 http "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH if n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH incr n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -8,8 +8,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH info n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/interp.n b/doc/interp.n index 6ce10ee..92113a6 100644 --- a/doc/interp.n +++ b/doc/interp.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH interp n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH join n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lappend.n b/doc/lappend.n index 9bfab72..a324ca3 100644 --- a/doc/lappend.n +++ b/doc/lappend.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lappend n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lassign.n b/doc/lassign.n index 6f5042b..e250729 100644 --- a/doc/lassign.n +++ b/doc/lassign.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lassign n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/library.n b/doc/library.n index 98dcb35..775b7d9 100644 --- a/doc/library.n +++ b/doc/library.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH library n "8.0" Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures diff --git a/doc/lindex.n b/doc/lindex.n index bb272a6..b42904b 100644 --- a/doc/lindex.n +++ b/doc/lindex.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lindex n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/linsert.n b/doc/linsert.n index c722e4f..51b64cf 100644 --- a/doc/linsert.n +++ b/doc/linsert.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH linsert n 8.2 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH list n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/llength.n b/doc/llength.n index b0ee4d9..d3f9610 100644 --- a/doc/llength.n +++ b/doc/llength.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH llength n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lmap n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH load n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lrange.n b/doc/lrange.n index 4f4816a..4e26a0f 100644 --- a/doc/lrange.n +++ b/doc/lrange.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lrange n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lrepeat.n b/doc/lrepeat.n index 59a1edf..466339d 100644 --- a/doc/lrepeat.n +++ b/doc/lrepeat.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lrepeat n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lreplace.n b/doc/lreplace.n index 6e6c3ea..7bba543 100644 --- a/doc/lreplace.n +++ b/doc/lreplace.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lreplace n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lreverse.n b/doc/lreverse.n index f52db9b..51a9e57 100644 --- a/doc/lreverse.n +++ b/doc/lreverse.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lreverse n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lsearch.n b/doc/lsearch.n index 7835352..44ebce4 100644 --- a/doc/lsearch.n +++ b/doc/lsearch.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lsearch n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lset n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/lsort.n b/doc/lsort.n index 312048e..48c62f0 100644 --- a/doc/lsort.n +++ b/doc/lsort.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH lsort n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 14b448e..84853d8 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/mathop.n b/doc/mathop.n index ac2ebc1..4c16d76 100644 --- a/doc/mathop.n +++ b/doc/mathop.n @@ -4,8 +4,8 @@ .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" -.so man.macros .TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/memory.n b/doc/memory.n index f82c5b4..5a1524b 100644 --- a/doc/memory.n +++ b/doc/memory.n @@ -3,8 +3,8 @@ '\" Copyright (c) 2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH memory n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS .SH NAME memory \- Control Tcl memory debugging capabilities diff --git a/doc/msgcat.n b/doc/msgcat.n index bfd94ae..bae6dbe 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH my n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/namespace.n b/doc/namespace.n index f2812b2..1f4e85f 100644 --- a/doc/namespace.n +++ b/doc/namespace.n @@ -7,8 +7,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH namespace n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH next n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/object.n b/doc/object.n index 6737e7e..df657a9 100644 --- a/doc/object.n +++ b/doc/object.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH object n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH open n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/package.n b/doc/package.n index 6cf8991..07a3d47 100644 --- a/doc/package.n +++ b/doc/package.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH package n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/packagens.n b/doc/packagens.n index 30617a3..61e7eca 100644 --- a/doc/packagens.n +++ b/doc/packagens.n @@ -2,8 +2,8 @@ '\" Copyright (c) 1998-2000 by Scriptics Corporation. '\" All rights reserved. '\" -.so man.macros .TH pkg::create n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pid n 7.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n index 2753208..c2f23ed 100644 --- a/doc/pkgMkIndex.n +++ b/doc/pkgMkIndex.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/platform.n b/doc/platform.n index 1553698..6abc289 100644 --- a/doc/platform.n +++ b/doc/platform.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "platform" n 1.0.4 platform "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/platform_shell.n b/doc/platform_shell.n index eef4d4e..64a2e46 100644 --- a/doc/platform_shell.n +++ b/doc/platform_shell.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/prefix.n b/doc/prefix.n index eb79996..344ade7 100644 --- a/doc/prefix.n +++ b/doc/prefix.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH prefix n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH proc n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH puts n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH pwd n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH read n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/refchan.n b/doc/refchan.n index a51c3d7..2232d50 100644 --- a/doc/refchan.n +++ b/doc/refchan.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH refchan n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/regexp.n b/doc/regexp.n index 5e857f8..17bf564 100644 --- a/doc/regexp.n +++ b/doc/regexp.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH regexp n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/registry.n b/doc/registry.n index 2e69b1e..001def9 100644 --- a/doc/registry.n +++ b/doc/registry.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH registry n 1.1 registry "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/regsub.n b/doc/regsub.n index fe473d9..ef4c289 100644 --- a/doc/regsub.n +++ b/doc/regsub.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH regsub n 8.3 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/rename.n b/doc/rename.n index 77dc095..744bf5a 100644 --- a/doc/rename.n +++ b/doc/rename.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH rename n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/return.n b/doc/return.n index a1abccf..383ed8c 100644 --- a/doc/return.n +++ b/doc/return.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH return n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH scan n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -99,7 +99,7 @@ The input substring must be an octal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. .TP -\fBx\fR +\fBx\fR or \fBX\fR . The input substring must be a hexadecimal integer. It is read in and the integer value is stored in the variable, @@ -140,7 +140,7 @@ substring may be a white-space character. The input substring consists of all the characters up to the next white-space character; the characters are copied to the variable. .TP -\fBe\fR or \fBf\fR or \fBg\fR +\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR . The input substring must be a floating-point number consisting of an optional sign, a string of decimal digits possibly @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH seek n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH self n 0.1 TclOO "TclOO Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH set n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/socket.n b/doc/socket.n index 0a60457..b7a4a45 100644 --- a/doc/socket.n +++ b/doc/socket.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH socket n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/source.n b/doc/source.n index 57a9fa2..9f488c5 100644 --- a/doc/source.n +++ b/doc/source.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH source n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/split.n b/doc/split.n index e3259df..f1c66d0 100644 --- a/doc/split.n +++ b/doc/split.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH split n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/string.n b/doc/string.n index 351c865..76005fc 100644 --- a/doc/string.n +++ b/doc/string.n @@ -5,8 +5,8 @@ .\" See the file "license.terms" for information on usage and redistribution .\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. .\" -.so man.macros .TH string n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS .\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/subst.n b/doc/subst.n index aba2bc9..990b9d3 100644 --- a/doc/subst.n +++ b/doc/subst.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH subst n 7.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/switch.n b/doc/switch.n index acde6cb..6e27f56 100644 --- a/doc/switch.n +++ b/doc/switch.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH switch n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tailcall.n b/doc/tailcall.n index 6a88aca..926c608 100644 --- a/doc/tailcall.n +++ b/doc/tailcall.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tailcall n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tclsh.1 b/doc/tclsh.1 index dfc2635..6ed5eb6 100644 --- a/doc/tclsh.1 +++ b/doc/tclsh.1 @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tclsh 1 "" Tcl "Tcl Applications" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tcltest.n b/doc/tcltest.n index 731bed7..8d2398b 100644 --- a/doc/tcltest.n +++ b/doc/tcltest.n @@ -8,8 +8,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/tclvars.n b/doc/tclvars.n index 44a8e11..2fec222 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tell n 8.1 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/throw.n b/doc/throw.n index b28f2e4..0d1df78 100644 --- a/doc/throw.n +++ b/doc/throw.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH throw n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH time n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH tm n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/trace.n b/doc/trace.n index 63ed1cb..4ae7e19 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH trace n "8.4" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/transchan.n b/doc/transchan.n index e308e13..e00aa84 100644 --- a/doc/transchan.n +++ b/doc/transchan.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH transchan n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH try n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/unknown.n b/doc/unknown.n index fc2a5a1..cdfbe43 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unknown n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/unload.n b/doc/unload.n index 4c0b292..febd694 100644 --- a/doc/unload.n +++ b/doc/unload.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unload n 8.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/unset.n b/doc/unset.n index 64b334d..8b63959 100644 --- a/doc/unset.n +++ b/doc/unset.n @@ -6,8 +6,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH unset n 8.4 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/update.n b/doc/update.n index 0c77c5f..875172a 100644 --- a/doc/update.n +++ b/doc/update.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH update n 7.5 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/uplevel.n b/doc/uplevel.n index 6c8a957..a96f729 100644 --- a/doc/uplevel.n +++ b/doc/uplevel.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH uplevel n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/upvar.n b/doc/upvar.n index 60e5324..380a390 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH upvar n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/variable.n b/doc/variable.n index 96263b6..7d58a02 100644 --- a/doc/variable.n +++ b/doc/variable.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH variable n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/vwait.n b/doc/vwait.n index 38a8081..c9b51ab 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH vwait n 8.0 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/doc/while.n b/doc/while.n index 5416e25..60275e8 100644 --- a/doc/while.n +++ b/doc/while.n @@ -5,8 +5,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH while n "" Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME @@ -4,8 +4,8 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.so man.macros .TH zlib n 8.6 Tcl "Tcl Built-In Commands" +.so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME diff --git a/generic/regc_locale.c b/generic/regc_locale.c index e79dff8..0f8d1b2 100644 --- a/generic/regc_locale.c +++ b/generic/regc_locale.c @@ -118,7 +118,7 @@ static const struct cname { * Unicode character-class tables. */ -typedef struct crange { +typedef struct { chr start; chr end; } crange; @@ -260,7 +260,7 @@ static const chr alphaCharTable[] = { static const crange controlRangeTable[] = { {0x0, 0x1f}, {0x7f, 0x9f}, {0x600, 0x604}, {0x200b, 0x200f}, - {0x202a, 0x202e}, {0x2060, 0x2064}, {0x206a, 0x206f}, {0xe000, 0xf8ff}, + {0x202a, 0x202e}, {0x2060, 0x2064}, {0x2066, 0x206f}, {0xe000, 0xf8ff}, {0xfff9, 0xfffb} #if TCL_UTF_MAX > 4 ,{0x1d173, 0x1d17a}, {0xe0020, 0xe007f}, {0xf0000, 0xffffd}, {0x100000, 0x10fffd} @@ -270,7 +270,7 @@ static const crange controlRangeTable[] = { #define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange)) static const chr controlCharTable[] = { - 0xad, 0x6dd, 0x70f, 0xfeff + 0xad, 0x61c, 0x6dd, 0x70f, 0x180e, 0xfeff #if TCL_UTF_MAX > 4 ,0x110bd, 0xe0001 #endif @@ -316,12 +316,13 @@ static const crange punctRangeTable[] = { {0x17d8, 0x17da}, {0x1800, 0x180a}, {0x1aa0, 0x1aa6}, {0x1aa8, 0x1aad}, {0x1b5a, 0x1b60}, {0x1bfc, 0x1bff}, {0x1c3b, 0x1c3f}, {0x1cc0, 0x1cc7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205e}, - {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, {0x29d8, 0x29db}, - {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, {0x3001, 0x3003}, - {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, {0xa6f2, 0xa6f7}, - {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, {0xaa5c, 0xaa5f}, - {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, {0xff01, 0xff03}, - {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, {0xff5f, 0xff65} + {0x2308, 0x230b}, {0x2768, 0x2775}, {0x27e6, 0x27ef}, {0x2983, 0x2998}, + {0x29d8, 0x29db}, {0x2cf9, 0x2cfc}, {0x2e00, 0x2e2e}, {0x2e30, 0x2e3b}, + {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301f}, {0xa60d, 0xa60f}, + {0xa6f2, 0xa6f7}, {0xa874, 0xa877}, {0xa8f8, 0xa8fa}, {0xa9c1, 0xa9cd}, + {0xaa5c, 0xaa5f}, {0xfe10, 0xfe19}, {0xfe30, 0xfe52}, {0xfe54, 0xfe61}, + {0xff01, 0xff03}, {0xff05, 0xff0a}, {0xff0c, 0xff0f}, {0xff3b, 0xff3d}, + {0xff5f, 0xff65} #if TCL_UTF_MAX > 4 ,{0x10100, 0x10102}, {0x10a50, 0x10a58}, {0x10b39, 0x10b3f}, {0x11047, 0x1104d}, {0x110be, 0x110c1}, {0x11140, 0x11143}, {0x111c5, 0x111c8}, {0x12470, 0x12473} diff --git a/generic/tcl.h b/generic/tcl.h index 1b120fb..4bf81cc 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -168,7 +168,7 @@ extern "C" { */ #if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1))) -# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5)) +# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5)) # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg))) # else # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__)) @@ -458,7 +458,7 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt; typedef struct _stat32i64 Tcl_StatBuf; # endif /* _MSC_VER < 1400 */ #elif defined(__CYGWIN__) - typedef struct _stat32i64 { + typedef struct { dev_t st_dev; unsigned short st_ino; unsigned short st_mode; diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 946c729..89c286a 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -349,7 +349,8 @@ static const TalInstDesc TalInstructionTable[] = { {"bitnot", ASSEM_1BYTE, INST_BITNOT, 1, 1}, {"bitor", ASSEM_1BYTE, INST_BITOR, 2, 1}, {"bitxor", ASSEM_1BYTE, INST_BITXOR, 2, 1}, - {"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1}, + {"concat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, + {"concatStk", ASSEM_LIST, INST_CONCAT_STK, INT_MIN,1}, {"coroName", ASSEM_1BYTE, INST_COROUTINE_NAME, 0, 1}, {"currentNamespace",ASSEM_1BYTE, INST_NS_CURRENT, 0, 1}, {"dictAppend", ASSEM_LVT4, INST_DICT_APPEND, 2, 1}, @@ -436,6 +437,7 @@ static const TalInstDesc TalInstructionTable[] = { {"nop", ASSEM_1BYTE, INST_NOP, 0, 0}, {"not", ASSEM_1BYTE, INST_LNOT, 1, 1}, {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}, + {"originCmd", ASSEM_1BYTE, INST_ORIGIN_COMMAND, 1, 1}, {"over", ASSEM_OVER, INST_OVER, INT_MIN,-1-1}, {"pop", ASSEM_1BYTE, INST_POP, 1, 0}, {"pushReturnCode", ASSEM_1BYTE, INST_PUSH_RETURN_CODE, 0, 1}, @@ -452,7 +454,11 @@ static const TalInstDesc TalInstructionTable[] = { | INST_STORE_ARRAY4), 2, 1}, {"storeArrayStk", ASSEM_1BYTE, INST_STORE_ARRAY_STK, 3, 1}, {"storeStk", ASSEM_1BYTE, INST_STORE_STK, 2, 1}, + {"strcaseLower", ASSEM_1BYTE, INST_STR_LOWER, 1, 1}, + {"strcaseTitle", ASSEM_1BYTE, INST_STR_TITLE, 1, 1}, + {"strcaseUpper", ASSEM_1BYTE, INST_STR_UPPER, 1, 1}, {"strcmp", ASSEM_1BYTE, INST_STR_CMP, 2, 1}, + {"strcat", ASSEM_CONCAT1, INST_STR_CONCAT1, INT_MIN,1}, {"streq", ASSEM_1BYTE, INST_STR_EQ, 2, 1}, {"strfind", ASSEM_1BYTE, INST_STR_FIND, 2, 1}, {"strindex", ASSEM_1BYTE, INST_STR_INDEX, 2, 1}, @@ -461,7 +467,11 @@ static const TalInstDesc TalInstructionTable[] = { {"strmatch", ASSEM_BOOL, INST_STR_MATCH, 2, 1}, {"strneq", ASSEM_1BYTE, INST_STR_NEQ, 2, 1}, {"strrange", ASSEM_1BYTE, INST_STR_RANGE, 3, 1}, + {"strreplace", ASSEM_1BYTE, INST_STR_REPLACE, 4, 1}, {"strrfind", ASSEM_1BYTE, INST_STR_FIND_LAST, 2, 1}, + {"strtrim", ASSEM_1BYTE, INST_STR_TRIM, 2, 1}, + {"strtrimLeft", ASSEM_1BYTE, INST_STR_TRIM_LEFT, 2, 1}, + {"strtrimRight", ASSEM_1BYTE, INST_STR_TRIM_RIGHT, 2, 1}, {"sub", ASSEM_1BYTE, INST_SUB, 2, 1}, {"tclooClass", ASSEM_1BYTE, INST_TCLOO_CLASS, 1, 1}, {"tclooIsObject", ASSEM_1BYTE, INST_TCLOO_IS_OBJECT, 1, 1}, @@ -493,6 +503,7 @@ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ + INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ INST_REVERSE, /* 126 */ @@ -502,7 +513,10 @@ static const unsigned char NonThrowingByteCodes[] = { INST_COROUTINE_NAME, /* 149 */ INST_NS_CURRENT, /* 151 */ INST_INFO_LEVEL_NUM, /* 152 */ - INST_RESOLVE_COMMAND /* 154 */ + INST_RESOLVE_COMMAND, /* 154 */ + INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT, /* 166-168 */ + INST_CONCAT_STK, /* 169 */ + INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE /* 170-172 */ }; /* @@ -682,7 +696,7 @@ BBEmitInstInt4( * BBEmitInst1or4 -- * * Emits a 1- or 4-byte operation according to the magnitude of the - * operand + * operand. * *----------------------------------------------------------------------------- */ diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 5131571..0442446 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -211,7 +211,7 @@ static const CmdInfo builtInCmds[] = { {"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE}, #endif {"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE}, - {"concat", Tcl_ConcatObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, @@ -227,7 +227,7 @@ static const CmdInfo builtInCmds[] = { {"lappend", Tcl_LappendObjCmd, TclCompileLappendCmd, NULL, CMD_IS_SAFE}, {"lassign", Tcl_LassignObjCmd, TclCompileLassignCmd, NULL, CMD_IS_SAFE}, {"lindex", Tcl_LindexObjCmd, TclCompileLindexCmd, NULL, CMD_IS_SAFE}, - {"linsert", Tcl_LinsertObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"linsert", Tcl_LinsertObjCmd, TclCompileLinsertCmd, NULL, CMD_IS_SAFE}, {"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED}, {"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE}, {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, @@ -526,6 +526,9 @@ Tcl_CreateInterp(void) iPtr->hiddenCmdTablePtr = NULL; iPtr->interpInfo = NULL; + TCL_CT_ASSERT(sizeof(iPtr->extra) <= sizeof(Tcl_HashTable)); + iPtr->extra.optimizer = TclOptimizeBytecode; + iPtr->numLevels = 0; iPtr->maxNestingDepth = MAX_NESTING_DEPTH; iPtr->framePtr = NULL; /* Initialise as soon as :: is available */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index fa4ead4..41c1eb6 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1147,41 +1147,38 @@ InfoFrameCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - int level, topLevel, code = TCL_OK; - CmdFrame *runPtr, *framePtr; + int level, code = TCL_OK; + CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr; CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + int topLevel = 0; if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?number?"); return TCL_ERROR; } - topLevel = ((iPtr->cmdFramePtr == NULL) - ? 0 - : iPtr->cmdFramePtr->level); - - if (corPtr) { - /* - * A coroutine: must fix the level computations AND the cmdFrame chain, - * which is interrupted at the base. - */ - - CmdFrame *lastPtr = NULL; - - runPtr = iPtr->cmdFramePtr; + while (corPtr) { + while (*cmdFramePtrPtr) { + topLevel++; + cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr); + } + if (corPtr->caller.cmdFramePtr) { + *cmdFramePtrPtr = corPtr->caller.cmdFramePtr; + } + corPtr = corPtr->callerEEPtr->corPtr; + } + topLevel += (*cmdFramePtrPtr)->level; - /* TODO - deal with overflow */ - topLevel += corPtr->caller.cmdFramePtr->level; - while (runPtr) { - runPtr->level += corPtr->caller.cmdFramePtr->level; - lastPtr = runPtr; - runPtr = runPtr->nextPtr; + if (topLevel != iPtr->cmdFramePtr->level) { + framePtr = iPtr->cmdFramePtr; + while (framePtr) { + framePtr->level = topLevel--; + framePtr = framePtr->nextPtr; } - if (lastPtr) { - lastPtr->nextPtr = corPtr->caller.cmdFramePtr; - } else { - iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr; + if (topLevel) { + Tcl_Panic("Broken frame level calculation"); } + topLevel = iPtr->cmdFramePtr->level; } if (objc == 1) { @@ -1231,20 +1228,27 @@ InfoFrameCmd( Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); done: - if (corPtr) { + cmdFramePtrPtr = &iPtr->cmdFramePtr; + corPtr = iPtr->execEnvPtr->corPtr; + while (corPtr) { + CmdFrame *endPtr = corPtr->caller.cmdFramePtr; + + if (endPtr) { + if (*cmdFramePtrPtr == endPtr) { + *cmdFramePtrPtr = NULL; + } else { + CmdFrame *runPtr = *cmdFramePtrPtr; - if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) { - iPtr->cmdFramePtr = NULL; - } else { - runPtr = iPtr->cmdFramePtr; - while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) { - runPtr->level -= corPtr->caller.cmdFramePtr->level; - runPtr = runPtr->nextPtr; + while (runPtr->nextPtr != endPtr) { + runPtr->level -= endPtr->level; + runPtr = runPtr->nextPtr; + } + runPtr->level = 1; + runPtr->nextPtr = NULL; } - runPtr->level = 1; - runPtr->nextPtr = NULL; + cmdFramePtrPtr = &corPtr->caller.cmdFramePtr; } - + corPtr = corPtr->callerEEPtr->corPtr; } return code; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 5087fbb..d477216 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -18,6 +18,7 @@ #include "tclInt.h" #include "tclRegexp.h" +#include "tclStringTrim.h" static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode, Tcl_Obj *oldOptions, Tcl_Obj *errorInfo); @@ -31,38 +32,6 @@ static int TryPostHandler(ClientData data[], Tcl_Interp *interp, int result); static int UniCharIsAscii(int character); static int UniCharIsHexDigit(int character); - -/* - * Default set of characters to trim in [string trim] and friends. This is a - * UTF-8 literal string containing all Unicode space characters [TIP #413] - */ - -#define DEFAULT_TRIM_SET \ - "\x09\x0a\x0b\x0c\x0d " /* ASCII */\ - "\xc0\x80" /* nul (U+0000) */\ - "\xc2\x85" /* next line (U+0085) */\ - "\xc2\xa0" /* non-breaking space (U+00a0) */\ - "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \ - "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\ - "\xe2\x80\x80" /* en quad (U+2000) */\ - "\xe2\x80\x81" /* em quad (U+2001) */\ - "\xe2\x80\x82" /* en space (U+2002) */\ - "\xe2\x80\x83" /* em space (U+2003) */\ - "\xe2\x80\x84" /* three-per-em space (U+2004) */\ - "\xe2\x80\x85" /* four-per-em space (U+2005) */\ - "\xe2\x80\x86" /* six-per-em space (U+2006) */\ - "\xe2\x80\x87" /* figure space (U+2007) */\ - "\xe2\x80\x88" /* punctuation space (U+2008) */\ - "\xe2\x80\x89" /* thin space (U+2009) */\ - "\xe2\x80\x8a" /* hair space (U+200a) */\ - "\xe2\x80\x8b" /* zero width space (U+200b) */\ - "\xe2\x80\xa8" /* line separator (U+2028) */\ - "\xe2\x80\xa9" /* paragraph separator (U+2029) */\ - "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\ - "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\ - "\xe2\x81\xa0" /* word joiner (U+2060) */\ - "\xe3\x80\x80" /* ideographic space (U+3000) */\ - "\xef\xbb\xbf" /* zero width no-break space (U+feff) */ /* *---------------------------------------------------------------------- @@ -3337,14 +3306,14 @@ TclInitStringCmd( {"match", StringMatchCmd, TclCompileStringMatchCmd, NULL, NULL, 0}, {"range", StringRangeCmd, TclCompileStringRangeCmd, NULL, NULL, 0}, {"repeat", StringReptCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, - {"replace", StringRplcCmd, NULL, NULL, NULL, 0}, + {"replace", StringRplcCmd, TclCompileStringReplaceCmd, NULL, NULL, 0}, {"reverse", StringRevCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"tolower", StringLowerCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, - {"toupper", StringUpperCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, - {"totitle", StringTitleCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, - {"trim", StringTrimCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, - {"trimleft", StringTrimLCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, - {"trimright", StringTrimRCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, + {"tolower", StringLowerCmd, TclCompileStringToLowerCmd, NULL, NULL, 0}, + {"toupper", StringUpperCmd, TclCompileStringToUpperCmd, NULL, NULL, 0}, + {"totitle", StringTitleCmd, TclCompileStringToTitleCmd, NULL, NULL, 0}, + {"trim", StringTrimCmd, TclCompileStringTrimCmd, NULL, NULL, 0}, + {"trimleft", StringTrimLCmd, TclCompileStringTrimLCmd, NULL, NULL, 0}, + {"trimright", StringTrimRCmd, TclCompileStringTrimRCmd, NULL, NULL, 0}, {"wordend", StringEndCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {"wordstart", StringStartCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 8f4363b..431f0af 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -37,6 +37,12 @@ static void PrintForeachInfo(ClientData clientData, static void DisassembleForeachInfo(ClientData clientData, Tcl_Obj *dictObj, ByteCode *codePtr, unsigned int pcOffset); +static void PrintNewForeachInfo(ClientData clientData, + Tcl_Obj *appendObj, ByteCode *codePtr, + unsigned int pcOffset); +static void DisassembleNewForeachInfo(ClientData clientData, + Tcl_Obj *dictObj, ByteCode *codePtr, + unsigned int pcOffset); static int CompileEachloopCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, int collect); @@ -56,6 +62,14 @@ const AuxDataType tclForeachInfoType = { DisassembleForeachInfo /* disassembleProc */ }; +const AuxDataType tclNewForeachInfoType = { + "NewForeachInfo", /* name */ + DupForeachInfo, /* dupProc */ + FreeForeachInfo, /* freeProc */ + PrintNewForeachInfo, /* printProc */ + DisassembleNewForeachInfo /* disassembleProc */ +}; + const AuxDataType tclDictUpdateInfoType = { "DictUpdateInfo", /* name */ DupDictUpdateInfo, /* dupProc */ @@ -253,8 +267,8 @@ TclCompileArraySetCmd( Tcl_Token *varTokenPtr, *dataTokenPtr; int isScalar, localIndex, code = TCL_OK; int isDataLiteral, isDataValid, isDataEven, len; - int dataVar, iterVar, keyVar, valVar, infoIndex; - int back, fwd, offsetBack, offsetFwd; + int keyVar, valVar, infoIndex; + int fwd, offsetBack, offsetFwd; Tcl_Obj *literalObj; ForeachInfo *infoPtr; @@ -276,8 +290,8 @@ TclCompileArraySetCmd( if (isDataValid && !isDataEven) { PushStringLiteral(envPtr, "list must have an even number of elements"); - PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); - TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr); + PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}"); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); goto done; } @@ -298,6 +312,7 @@ TclCompileArraySetCmd( code = TCL_ERROR; goto done; } + /* * Special case: literal empty value argument is just an "ensure array" * operation. @@ -322,20 +337,29 @@ TclCompileArraySetCmd( goto done; } + if (localIndex < 0) { + /* + * a non-local variable: upvar from a local one! This consumes the + * variable name that was left at stacktop. + */ + + localIndex = AnonymousLocal(envPtr); + PushStringLiteral(envPtr, "0"); + TclEmitInstInt4(INST_REVERSE, 2, envPtr); + TclEmitInstInt4(INST_UPVAR, localIndex, envPtr); + TclEmitOpcode(INST_POP, envPtr); + } + /* * Prepare for the internal foreach. */ - dataVar = AnonymousLocal(envPtr); - iterVar = AnonymousLocal(envPtr); keyVar = AnonymousLocal(envPtr); valVar = AnonymousLocal(envPtr); - infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *)); + infoPtr = ckalloc(sizeof(ForeachInfo)); infoPtr->numLists = 1; - infoPtr->firstValueTemp = dataVar; - infoPtr->loopCtTemp = iterVar; - infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int)); + infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) + sizeof(int)); infoPtr->varLists[0]->numVars = 2; infoPtr->varLists[0]->varIndexes[0] = keyVar; infoPtr->varLists[0]->varIndexes[1] = valVar; @@ -361,61 +385,30 @@ TclCompileArraySetCmd( offsetFwd = CurrentOffset(envPtr); TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); PushStringLiteral(envPtr, "list must have an even number of elements"); - PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}"); - TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr); + PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}"); + TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR, envPtr); TclEmitInt4( 0, envPtr); TclAdjustStackDepth(-1, envPtr); fwd = CurrentOffset(envPtr) - offsetFwd; TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); } - Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); - if (localIndex >= 0) { - TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); - TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - } else { - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_EXISTS_STK, envPtr); - TclEmitInstInt1(INST_JUMP_TRUE1, 4, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_ARRAY_MAKE_STK, envPtr); - TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr); - offsetBack = CurrentOffset(envPtr); - TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr); - offsetFwd = CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr); - TclEmitOpcode( INST_DUP, envPtr); - Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); - Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); - TclEmitOpcode( INST_STORE_ARRAY_STK, envPtr); - TclEmitOpcode( INST_POP, envPtr); - back = offsetBack - CurrentOffset(envPtr); - TclEmitInstInt1(INST_JUMP1, back, envPtr); - fwd = CurrentOffset(envPtr) - offsetFwd; - TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1); - TclEmitOpcode( INST_POP, envPtr); - } - if (!isDataLiteral) { - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( dataVar, envPtr); - } + TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr); + TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr); + TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex, envPtr); + TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); + offsetBack = CurrentOffset(envPtr); + Emit14Inst( INST_LOAD_SCALAR, keyVar, envPtr); + Emit14Inst( INST_LOAD_SCALAR, valVar, envPtr); + Emit14Inst( INST_STORE_ARRAY, localIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); + infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */ + TclEmitOpcode( INST_FOREACH_STEP, envPtr); + TclEmitOpcode( INST_FOREACH_END, envPtr); + TclAdjustStackDepth(-3, envPtr); PushStringLiteral(envPtr, ""); - done: + + done: Tcl_DecrRefCount(literalObj); return code; } @@ -508,17 +501,14 @@ TclCompileBreakCmd( TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopBreakFixup(envPtr, auxPtr); - TclAdjustStackDepth(1, envPtr); } else { /* * Emit a real break. */ - PushStringLiteral(envPtr, ""); - TclEmitOpcode(INST_DUP, envPtr); - TclEmitInstInt4(INST_RETURN_IMM, TCL_BREAK, envPtr); - TclEmitInt4(0, envPtr); + TclEmitOpcode(INST_BREAK, envPtr); } + TclAdjustStackDepth(1, envPtr); return TCL_OK; } @@ -552,9 +542,10 @@ TclCompileCatchCmd( { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr; - int resultIndex, optsIndex, range; + int resultIndex, optsIndex, range, dropScript = 0; DefineLineInformation; /* TIP #280 */ - + int depth = TclGetStackDepth(envPtr); + /* * If syntax does not match what we expect for [catch], do not compile. * Let runtime checks determine if syntax has changed. @@ -601,11 +592,7 @@ TclCompileCatchCmd( /* * We will compile the catch command. Declare the exception range that it * uses. - */ - - range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); - - /* + * * If the body is a simple word, compile a BEGIN_CATCH instruction, * followed by the instructions to eval the body. * Otherwise, compile instructions to substitute the body text before @@ -618,6 +605,7 @@ TclCompileCatchCmd( * begin by undeflowing the stack below the mark set by BEGIN_CATCH4. */ + range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); @@ -628,71 +616,51 @@ TclCompileCatchCmd( TclEmitInstInt4( INST_BEGIN_CATCH4, range, envPtr); ExceptionRangeStarts(envPtr, range); TclEmitOpcode( INST_DUP, envPtr); - TclEmitOpcode( INST_EVAL_STK, envPtr); - } - /* Stack at this point: - * nonsimple: script <mark> result - * simple: <mark> result - */ - - if (resultIndex == -1) { - /* - * Special case when neither result nor options are being saved. In - * that case, we can skip quite a bit of the command epilogue; all we - * have to do is drop the result and push the return code (and, of - * course, finish the catch context). - */ - + TclEmitInvoke(envPtr, INST_EVAL_STK); + /* drop the script */ + dropScript = 1; + TclEmitInstInt4( INST_REVERSE, 2, envPtr); TclEmitOpcode( INST_POP, envPtr); - PushStringLiteral(envPtr, "0"); - TclEmitInstInt1( INST_JUMP1, 3, envPtr); - TclAdjustStackDepth(-1, envPtr); - ExceptionRangeTarget(envPtr, range, catchOffset); - TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); - ExceptionRangeEnds(envPtr, range); - TclEmitOpcode( INST_END_CATCH, envPtr); - - /* - * Stack at this point: - * nonsimple: script <mark> returnCode - * simple: <mark> returnCode - */ - - goto dropScriptAtEnd; } + ExceptionRangeEnds(envPtr, range); + /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. */ + TclCheckStackDepth(depth+1, envPtr); PushStringLiteral(envPtr, "0"); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); - /* Stack at this point: ?script? <mark> result TCL_OK */ /* * Emit the "error case" epilogue. Push the interpreter result and the * return code. */ - TclAdjustStackDepth(-2, envPtr); ExceptionRangeTarget(envPtr, range, catchOffset); - /* Stack at this point: ?script? */ + TclSetStackDepth(depth + dropScript, envPtr); + + if (dropScript) { + TclEmitOpcode( INST_POP, envPtr); + } + + + /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); - /* - * Update the target of the jump after the "no errors" code. - */ + /* Stack at this point on both branches: result returnCode */ - /* Stack at this point: ?script? result returnCode */ if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileCatchCmd: bad jump distance %d", (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset)); } /* - * Push the return options if the caller wants them. + * Push the return options if the caller wants them. This needs to happen + * before INST_END_CATCH */ if (optsIndex != -1) { @@ -703,53 +671,118 @@ TclCompileCatchCmd( * End the catch */ - ExceptionRangeEnds(envPtr, range); TclEmitOpcode( INST_END_CATCH, envPtr); /* - * At this point, the top of the stack is inconveniently ordered: - * ?script? result returnCode ?returnOptions? - * Reverse the stack to bring the result to the top. + * Save the result and return options if the caller wants them. This needs + * to happen after INST_END_CATCH (compile-3.6/7). */ if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 3, envPtr); - } else { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); + Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* - * Store the result and remove it from the stack. + * At this point, the top of the stack is inconveniently ordered: + * result returnCode + * Reverse the stack to store the result. */ - Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + if (resultIndex != -1) { + Emit14Inst( INST_STORE_SCALAR, resultIndex, envPtr); + } + TclEmitOpcode( INST_POP, envPtr); + + TclCheckStackDepth(depth+1, envPtr); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileConcatCmd -- + * + * Procedure called to compile the "concat" command. + * + * Results: + * Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer + * evaluation to runtime. + * + * Side effects: + * Instructions are added to envPtr to execute the "concat" command at + * runtime. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileConcatCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Obj *objPtr, *listObj; + Tcl_Token *tokenPtr; + int i; + + /* TODO: Consider compiling expansion case. */ + if (parsePtr->numWords == 1) { + /* + * [concat] without arguments just pushes an empty object. + */ + + PushStringLiteral(envPtr, ""); + return TCL_OK; + } /* - * Stack is now ?script? ?returnOptions? returnCode. - * If the options dict has been requested, it is buried on the stack under - * the return code. Reverse the stack to bring it to the top, store it and - * remove it from the stack. + * Test if all arguments are compile-time known. If they are, we can + * implement with a simple push. */ - if (optsIndex != -1) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - Emit14Inst( INST_STORE_SCALAR, optsIndex, envPtr); - TclEmitOpcode( INST_POP, envPtr); + listObj = Tcl_NewObj(); + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + tokenPtr = TokenAfter(tokenPtr); + objPtr = Tcl_NewObj(); + if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { + Tcl_DecrRefCount(objPtr); + Tcl_DecrRefCount(listObj); + listObj = NULL; + break; + } + (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } + if (listObj != NULL) { + Tcl_Obj **objs; + const char *bytes; + int len; - dropScriptAtEnd: + Tcl_ListObjGetElements(NULL, listObj, &len, &objs); + objPtr = Tcl_ConcatObj(len, objs); + Tcl_DecrRefCount(listObj); + bytes = Tcl_GetStringFromObj(objPtr, &len); + PushLiteral(envPtr, bytes, len); + Tcl_DecrRefCount(objPtr); + return TCL_OK; + } /* - * Stack is now ?script? result. Get rid of the subst'ed script if it's - * hanging arond. + * General case: runtime concat. */ - if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclEmitInstInt4( INST_REVERSE, 2, envPtr); - TclEmitOpcode( INST_POP, envPtr); + for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, i); } + TclEmitInstInt4( INST_CONCAT_STK, i-1, envPtr); + return TCL_OK; } @@ -804,17 +837,14 @@ TclCompileContinueCmd( TclCleanupStackForBreakContinue(envPtr, auxPtr); TclAddLoopContinueFixup(envPtr, auxPtr); - TclAdjustStackDepth(1, envPtr); } else { /* * Emit a real continue. */ - PushStringLiteral(envPtr, ""); - TclEmitOpcode(INST_DUP, envPtr); - TclEmitInstInt4(INST_RETURN_IMM, TCL_CONTINUE, envPtr); - TclEmitInt4(0, envPtr); + TclEmitOpcode(INST_CONTINUE, envPtr); } + TclAdjustStackDepth(1, envPtr); return TCL_OK; } @@ -1683,7 +1713,7 @@ TclCompileDictUpdateCmd( TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex, envPtr); TclEmitInt4( infoIndex, envPtr); - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr,INST_RETURN_STK); if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) { Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d", @@ -1747,7 +1777,7 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr); } /* @@ -2041,7 +2071,7 @@ TclCompileDictWithCmd( } else { TclEmitInstInt4( INST_DICT_RECOMBINE_IMM, dictVar, envPtr); } - TclEmitOpcode( INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); /* * Prepare for the start of the next command. @@ -2164,19 +2194,48 @@ TclCompileErrorCmd( { /* * General syntax: [error message ?errorInfo? ?errorCode?] - * However, we only deal with the case where there is just a message. */ - Tcl_Token *messageTokenPtr; + + Tcl_Token *tokenPtr; DefineLineInformation; /* TIP #280 */ - if (parsePtr->numWords != 2) { + if (parsePtr->numWords < 2 || parsePtr->numWords > 4) { return TCL_ERROR; } - messageTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushStringLiteral(envPtr, "-code error -level 0"); - CompileWord(envPtr, messageTokenPtr, interp, 1); - TclEmitOpcode(INST_RETURN_STK, envPtr); + /* + * Handle the message. + */ + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + + /* + * Construct the options. Note that -code and -level are not here. + */ + + if (parsePtr->numWords == 2) { + PushStringLiteral(envPtr, ""); + } else { + PushStringLiteral(envPtr, "-errorinfo"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + if (parsePtr->numWords == 3) { + TclEmitInstInt4( INST_LIST, 2, envPtr); + } else { + PushStringLiteral(envPtr, "-errorcode"); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + TclEmitInstInt4( INST_LIST, 4, envPtr); + } + } + + /* + * Issue the error via 'returnImm error 0'. + */ + + TclEmitInstInt4( INST_RETURN_IMM, TCL_ERROR, envPtr); + TclEmitInt4( 0, envPtr); return TCL_OK; } @@ -2342,6 +2401,7 @@ TclCompileForCmd( SetLineInformation(2); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + TclClearNumConversion(envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { @@ -2469,18 +2529,10 @@ CompileEachloopCmd( ForeachInfo *infoPtr; /* Points to the structure describing this * foreach command. Stored in a AuxData * record in the ByteCode. */ - int firstValueTemp; /* Index of the first temp var in the frame - * used to point to a value list. */ - int loopCtTemp; /* Index of temp var holding the loop's - * iteration count. */ - int collectVar = -1; /* Index of temp var holding the result var - * index. */ - + Tcl_Token *tokenPtr, *bodyTokenPtr; - unsigned char *jumpPc; - JumpFixup jumpFalseFixup; - int jumpBackDist, jumpBackOffset, infoIndex, range; - int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; + int jumpBackOffset, infoIndex, range; + int numWords, numLists, numVars, loopIndex, i, j, code; DefineLineInformation; /* TIP #280 */ /* @@ -2588,32 +2640,11 @@ CompileEachloopCmd( loopIndex++; } - if (collect == TCL_EACH_COLLECT) { - collectVar = AnonymousLocal(envPtr); - if (collectVar < 0) { - return TCL_ERROR; - } - } - /* - * We will compile the foreach command. Reserve (numLists + 1) temporary - * variables: - * - numLists temps to hold each value list - * - 1 temp for the loop counter (index of next element in each list) - * - * At this time we don't try to reuse temporaries; if there are two - * nonoverlapping foreach loops, they don't share any temps. + * We will compile the foreach command. */ code = TCL_OK; - firstValueTemp = -1; - for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - tempVar = AnonymousLocal(envPtr); - if (loopIndex == 0) { - firstValueTemp = tempVar; - } - } - loopCtTemp = AnonymousLocal(envPtr); /* * Create and initialize the ForeachInfo and ForeachVarList data @@ -2622,16 +2653,14 @@ CompileEachloopCmd( */ infoPtr = ckalloc(sizeof(ForeachInfo) - + numLists * sizeof(ForeachVarList *)); + + (numLists - 1) * sizeof(ForeachVarList *)); infoPtr->numLists = numLists; - infoPtr->firstValueTemp = firstValueTemp; - infoPtr->loopCtTemp = loopCtTemp; for (loopIndex = 0; loopIndex < numLists; loopIndex++) { ForeachVarList *varListPtr; numVars = varcList[loopIndex]; varListPtr = ckalloc(sizeof(ForeachVarList) - + numVars * sizeof(int)); + + (numVars - 1) * sizeof(int)); varListPtr->numVars = numVars; for (j = 0; j < numVars; j++) { const char *varName = varvList[loopIndex][j]; @@ -2642,131 +2671,77 @@ CompileEachloopCmd( } infoPtr->varLists[loopIndex] = varListPtr; } - infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); + infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr); /* - * Create an exception record to handle [break] and [continue]. + * Create the collecting object, unshared. */ - - range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); - + + if (collect == TCL_EACH_COLLECT) { + TclEmitInstInt4(INST_LIST, 0, envPtr); + } + /* - * Evaluate then store each value list in the associated temporary. + * Evaluate each value list and leave it on stack. */ - loopIndex = 0; for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { CompileWord(envPtr, tokenPtr, interp, i); - tempVar = (firstValueTemp + loopIndex); - Emit14Inst( INST_STORE_SCALAR, tempVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); - loopIndex++; } } - /* - * Create temporary variable to capture return values from loop body. - */ - - if (collect == TCL_EACH_COLLECT) { - PushStringLiteral(envPtr, ""); - Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); - TclEmitOpcode( INST_POP, envPtr); - } - - /* - * Initialize the temporary var that holds the count of loop iterations. - */ - - TclEmitInstInt4( INST_FOREACH_START4, infoIndex, envPtr); - - /* - * Top of loop code: assign each loop variable and check whether - * to terminate the loop. - */ - - ExceptionRangeTarget(envPtr, range, continueOffset); - TclEmitInstInt4( INST_FOREACH_STEP4, infoIndex, envPtr); - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup); - + TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr); + /* * Inline compile the loop body. */ + range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, range); BODY(bodyTokenPtr, numWords - 1); ExceptionRangeEnds(envPtr, range); - + if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr); - } - TclEmitOpcode( INST_POP, envPtr); - - /* - * Jump back to the test at the top of the loop. Generate a 4 byte jump if - * the distance to the test is > 120 bytes. This is conservative and - * ensures that we won't have to replace this jump if we later need to - * replace the ifFalse jump with a 4 byte jump. - */ - - jumpBackOffset = CurrentOffset(envPtr); - jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset; - if (jumpBackDist > 120) { - TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr); + TclEmitOpcode(INST_LMAP_COLLECT, envPtr); } else { - TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* - * Fix the target of the jump after the foreach_step test. + * Bottom of loop code: assign each loop variable and check whether + * to terminate the loop. Set the loop's break target. */ - if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) { - /* - * Update the loop body's starting PC offset since it moved down. - */ - - envPtr->exceptArrayPtr[range].codeOffset += 3; - - /* - * Update the jump back to the test at the top of the loop since it - * also moved down 3 bytes. - */ - - jumpBackOffset += 3; - jumpPc = (envPtr->codeStart + jumpBackOffset); - jumpBackDist += 3; - if (jumpBackDist > 120) { - TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc); - } else { - TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc); - } - } + ExceptionRangeTarget(envPtr, range, continueOffset); + TclEmitOpcode(INST_FOREACH_STEP, envPtr); + ExceptionRangeTarget(envPtr, range, breakOffset); + TclFinalizeLoopExceptionRange(envPtr, range); + TclEmitOpcode(INST_FOREACH_END, envPtr); + TclAdjustStackDepth(-(numLists+2), envPtr); /* - * Set the loop's break target. + * Set the jumpback distance from INST_FOREACH_STEP to the start of the + * body's code. Misuse loopCtTemp for storing the jump size. */ - - ExceptionRangeTarget(envPtr, range, breakOffset); - TclFinalizeLoopExceptionRange(envPtr, range); + + jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset - + envPtr->exceptArrayPtr[range].codeOffset; + infoPtr->loopCtTemp = -jumpBackOffset; /* - * The command's result is an empty string if not collecting, or the - * list of results from evaluating the loop body. + * The command's result is an empty string if not collecting. If + * collecting, it is automatically left on stack after FOREACH_END. */ - if (collect == TCL_EACH_COLLECT) { - Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); - TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr); - TclEmitInt4( collectVar, envPtr); - } else { + if (collect != TCL_EACH_COLLECT) { PushStringLiteral(envPtr, ""); } - - done: + + done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { if (varvList[loopIndex] != NULL) { ckfree(varvList[loopIndex]); @@ -2922,6 +2897,36 @@ PrintForeachInfo( } static void +PrintNewForeachInfo( + ClientData clientData, + Tcl_Obj *appendObj, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register ForeachInfo *infoPtr = clientData; + register ForeachVarList *varsPtr; + int i, j; + + Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+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%u", + (unsigned) varsPtr->varIndexes[j]); + } + Tcl_AppendToObj(appendObj, "]", -1); + } +} + +static void DisassembleForeachInfo( ClientData clientData, Tcl_Obj *dictObj, @@ -2967,6 +2972,42 @@ DisassembleForeachInfo( } Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); } + +static void +DisassembleNewForeachInfo( + ClientData clientData, + Tcl_Obj *dictObj, + ByteCode *codePtr, + unsigned int pcOffset) +{ + register ForeachInfo *infoPtr = clientData; + register ForeachVarList *varsPtr; + int i, j; + Tcl_Obj *objPtr, *innerPtr; + + /* + * Jump offset. + */ + + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1), + Tcl_NewIntObj(infoPtr->loopCtTemp)); + + /* + * Assignment targets. + */ + + objPtr = Tcl_NewObj(); + for (i=0 ; i<infoPtr->numLists ; i++) { + innerPtr = Tcl_NewObj(); + varsPtr = infoPtr->varLists[i]; + for (j=0 ; j<varsPtr->numVars ; j++) { + Tcl_ListObjAppendElement(NULL, innerPtr, + Tcl_NewIntObj(varsPtr->varIndexes[j])); + } + Tcl_ListObjAppendElement(NULL, objPtr, innerPtr); + } + Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr); +} /* *---------------------------------------------------------------------- @@ -3173,7 +3214,7 @@ TclCompileFormatCmd( * Do the concatenation, which produces the result. */ - TclEmitInstInt1(INST_CONCAT1, i, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr); } else { /* * EVIL HACK! Force there to be a string representation in the case diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index 43ea3d3..b8a7e0f 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -28,6 +28,58 @@ static void CompileReturnInternal(CompileEnv *envPtr, static int IndexTailVarIfKnown(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr); +#define INDEX_END (-2) + +/* + *---------------------------------------------------------------------- + * + * GetIndexFromToken -- + * + * Parse a token and get the encoded version of the index (as understood + * by TEBC), assuming it is at all knowable at compile time. Only handles + * indices that are integers or 'end' or 'end-integer'. + * + * Returns: + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * + * Side effects: + * Sets *index to the index value if successful. + * + *---------------------------------------------------------------------- + */ + +static inline int +GetIndexFromToken( + Tcl_Token *tokenPtr, + int *index) +{ + Tcl_Obj *tmpObj = Tcl_NewObj(); + int result, idx; + + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + + result = TclGetIntFromObj(NULL, tmpObj, &idx); + if (result == TCL_OK) { + if (idx < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); + if (result == TCL_OK && idx > INDEX_END) { + result = TCL_ERROR; + } + } + Tcl_DecrRefCount(tmpObj); + + if (result == TCL_OK) { + *index = idx; + } + + return result; +} /* *---------------------------------------------------------------------- @@ -229,6 +281,7 @@ TclCompileIfCmd( SetLineInformation(wordIdx); Tcl_ResetResult(interp); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + TclClearNumConversion(envPtr); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { TclExpandJumpFixupArray(&jumpFalseFixupArray); } @@ -478,6 +531,7 @@ TclCompileIncrCmd( } else { SetLineInformation(2); CompileTokens(envPtr, incrTokenPtr, interp); + TclClearNumConversion(envPtr); } } else { /* No incr amount given so use 1. */ haveImmValue = 1; @@ -1027,7 +1081,7 @@ TclCompileLassignCmd( */ TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4( -2 /* == "end" */, envPtr); + TclEmitInt4( INDEX_END, envPtr); return TCL_OK; } @@ -1060,7 +1114,7 @@ TclCompileLindexCmd( CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *idxTokenPtr, *valTokenPtr; - int i, numWords = parsePtr->numWords; + int i, idx, numWords = parsePtr->numWords; DefineLineInformation; /* TIP #280 */ /* @@ -1078,46 +1132,28 @@ TclCompileLindexCmd( } idxTokenPtr = TokenAfter(valTokenPtr); - if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - Tcl_Obj *tmpObj; - int idx, result; - - tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx); - if (result == TCL_OK) { - if (idx < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx); - if (result == TCL_OK && idx > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - - if (result == TCL_OK) { - /* - * All checks have been completed, and we have exactly one of - * these constructs: - * lindex <arbitraryValue> <posInt> - * lindex <arbitraryValue> end-<posInt> - * This is best compiled as a push of the arbitrary value followed - * by an "immediate lindex" which is the most efficient variety. - */ - - CompileWord(envPtr, valTokenPtr, interp, 1); - TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); - return TCL_OK; - } - + if (GetIndexFromToken(idxTokenPtr, &idx) == TCL_OK) { /* - * If the conversion failed or the value was negative, we just keep on - * going with the more complex compilation. + * All checks have been completed, and we have exactly one of these + * constructs: + * lindex <arbitraryValue> <posInt> + * lindex <arbitraryValue> end-<posInt> + * This is best compiled as a push of the arbitrary value followed by + * an "immediate lindex" which is the most efficient variety. */ + + CompileWord(envPtr, valTokenPtr, interp, 1); + TclEmitInstInt4( INST_LIST_INDEX_IMM, idx, envPtr); + return TCL_OK; } /* + * If the value was not known at compile time, the conversion failed or + * the value was negative, we just keep on going with the more complex + * compilation. + */ + + /* * Push the operands onto the stack. */ @@ -1263,7 +1299,7 @@ TclCompileListCmd( if (concat && numWords == 2) { TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); - TclEmitInt4( -2, envPtr); + TclEmitInt4( INDEX_END, envPtr); } return TCL_OK; } @@ -1330,8 +1366,7 @@ TclCompileLrangeCmd( { Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ - Tcl_Obj *tmpObj; - int idx1, idx2, result; + int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; @@ -1339,56 +1374,18 @@ TclCompileLrangeCmd( listTokenPtr = TokenAfter(parsePtr->tokenPtr); /* - * Parse the first index. Will only compile if it is constant and not an + * Parse the indices. Will only compile if both are constants and not an * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). + * end-relative indexing) or an end-based index greater than 'end' itself. */ tokenPtr = TokenAfter(listTokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx1); - if (result == TCL_OK) { - if (idx1 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1); - if (result == TCL_OK && idx1 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { return TCL_ERROR; } - /* - * Parse the second index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - return TCL_ERROR; - } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx2); - if (result == TCL_OK) { - if (idx2 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2); - if (result == TCL_OK && idx2 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { return TCL_ERROR; } @@ -1407,19 +1404,16 @@ TclCompileLrangeCmd( /* *---------------------------------------------------------------------- * - * TclCompileLreplaceCmd -- + * TclCompileLinsertCmd -- * - * How to compile the "lreplace" command. We only bother with the case - * where there are no elements to insert and where both the 'first' and - * 'last' arguments are constant and one can be deterined to be at the - * end of the list. (This is the case that could also be written with - * "lrange".) + * How to compile the "linsert" command. We only bother with the case + * where the index is constant. * *---------------------------------------------------------------------- */ int -TclCompileLreplaceCmd( +TclCompileLinsertCmd( Tcl_Interp *interp, /* Tcl interpreter for context. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the * command. */ @@ -1429,101 +1423,272 @@ TclCompileLreplaceCmd( { Tcl_Token *tokenPtr, *listTokenPtr; DefineLineInformation; /* TIP #280 */ - Tcl_Obj *tmpObj; - int idx1, idx2, result, guaranteedDropAll = 0; + int idx, i; - if (parsePtr->numWords != 4) { + if (parsePtr->numWords < 3) { return TCL_ERROR; } listTokenPtr = TokenAfter(parsePtr->tokenPtr); /* - * Parse the first index. Will only compile if it is constant and not an + * Parse the index. Will only compile if it is constant and not an * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). + * end-relative indexing) or an end-based index greater than 'end' itself. */ tokenPtr = TokenAfter(listTokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + if (GetIndexFromToken(tokenPtr, &idx) != TCL_OK) { return TCL_ERROR; } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx1); - if (result == TCL_OK) { - if (idx1 < 0) { - result = TCL_ERROR; - } + + /* + * There are four main cases. If there are no values to insert, this is + * just a confirm-listiness check. If the index is '0', this is a prepend. + * If the index is 'end' (== INDEX_END), this is an append. Otherwise, + * this is a splice (== split, insert values as list, concat-3). + */ + + CompileWord(envPtr, listTokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( INDEX_END, envPtr); + return TCL_OK; + } + + for (i=3 ; i<parsePtr->numWords ; i++) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, i); + } + TclEmitInstInt4( INST_LIST, i-3, envPtr); + + if (idx == 0 /*start*/) { + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + } else if (idx == INDEX_END /*end*/) { + TclEmitOpcode( INST_LIST_CONCAT, envPtr); } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1); - if (result == TCL_OK && idx1 > -2) { - result = TCL_ERROR; + if (idx < 0) { + idx++; } + TclEmitInstInt4( INST_OVER, 1, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx-1, envPtr); + TclEmitInstInt4( INST_REVERSE, 3, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclCompileLreplaceCmd -- + * + * How to compile the "lreplace" command. We only bother with the case + * where the indices are constant. + * + *---------------------------------------------------------------------- + */ + +int +TclCompileLreplaceCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *listTokenPtr; + DefineLineInformation; /* TIP #280 */ + Tcl_Obj *tmpObj; + int idx1, idx2, i, offset; + + if (parsePtr->numWords < 4) { return TCL_ERROR; } + listTokenPtr = TokenAfter(parsePtr->tokenPtr); /* - * Parse the second index. Will only compile if it is constant and not an + * Parse the indices. Will only compile if both are constants and not an * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). + * end-relative indexing) or an end-based index greater than 'end' itself. */ - tokenPtr = TokenAfter(tokenPtr); - if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { + tokenPtr = TokenAfter(listTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { return TCL_ERROR; } - tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size); - result = TclGetIntFromObj(NULL, tmpObj, &idx2); - if (result == TCL_OK) { - if (idx2 < 0) { - result = TCL_ERROR; - } - } else { - result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2); - if (result == TCL_OK && idx2 > -2) { - result = TCL_ERROR; - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + + tokenPtr = TokenAfter(tokenPtr); + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { return TCL_ERROR; } /* - * Sanity check: can only issue when we're removing a range at one or - * other end of the list. If we're at one end or the other, convert the - * indices into the equivalent for an [lrange]. + * Work out what this [lreplace] is actually doing. */ + tmpObj = NULL; + CompileWord(envPtr, listTokenPtr, interp, 1); + if (parsePtr->numWords == 4) { + if (idx1 == 0) { + if (idx2 == INDEX_END) { + goto dropAll; + } + idx1 = idx2 + 1; + idx2 = INDEX_END; + goto dropEnd; + } else if (idx2 == INDEX_END) { + idx2 = idx1 - 1; + idx1 = 0; + goto dropEnd; + } else { + if (idx1 > 0) { + tmpObj = Tcl_NewIntObj(idx1); + Tcl_IncrRefCount(tmpObj); + } + goto dropRange; + } + } + + tokenPtr = TokenAfter(tokenPtr); + for (i=4 ; i<parsePtr->numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + TclEmitInstInt4( INST_LIST, i - 4, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); if (idx1 == 0) { - if (idx2 == -2) { - guaranteedDropAll = 1; + if (idx2 == INDEX_END) { + goto replaceAll; } idx1 = idx2 + 1; - idx2 = -2; - } else if (idx2 == -2) { + idx2 = INDEX_END; + goto replaceHead; + } else if (idx2 == INDEX_END) { idx2 = idx1 - 1; idx1 = 0; + goto replaceTail; } else { - return TCL_ERROR; + if (idx1 > 0 && idx2 > 0 && idx2 < idx1) { + idx2 = idx1 - 1; + } else if (idx1 < 0 && idx2 < 0 && idx2 < idx1) { + idx2 = idx1 - 1; + } + if (idx1 > 0) { + tmpObj = Tcl_NewIntObj(idx1); + Tcl_IncrRefCount(tmpObj); + } + goto replaceRange; } /* - * Issue instructions. It's not safe to skip doing the LIST_RANGE, as - * we've not proved that the 'list' argument is really a list. Not that it - * is worth trying to do that given current knowledge. + * Issue instructions to perform the operations relating to configurations + * that just drop. The only argument pushed on the stack is the list to + * operate on. */ - CompileWord(envPtr, listTokenPtr, interp, 1); - if (guaranteedDropAll) { + dropAll: + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitOpcode( INST_POP, envPtr); + PushStringLiteral(envPtr, ""); + goto done; + + dropEnd: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + goto done; + + dropRange: + if (tmpObj != NULL) { + TclEmitOpcode( INST_DUP, envPtr); TclEmitOpcode( INST_LIST_LENGTH, envPtr); - TclEmitOpcode( INST_POP, envPtr); - PushStringLiteral(envPtr, ""); - } else { - TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); - TclEmitInt4( idx2, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); + TclEmitOpcode( INST_GT, envPtr); + offset = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( + "list doesn't contain element %d", idx1), NULL), envPtr); + CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, + Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, + envPtr->codeStart + offset + 1); + TclAdjustStackDepth(-1, envPtr); + } + TclEmitOpcode( INST_DUP, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx1 - 1, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + /* + * Issue instructions to perform the operations relating to configurations + * that do real replacement. All arguments are pushed and assembled into a + * pair: the list of values to replace with, and the list to do the + * surgery on. + */ + + replaceAll: + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitOpcode( INST_POP, envPtr); + goto done; + + replaceHead: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + replaceTail: + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx1, envPtr); + TclEmitInt4( idx2, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + replaceRange: + if (tmpObj != NULL) { + TclEmitOpcode( INST_DUP, envPtr); + TclEmitOpcode( INST_LIST_LENGTH, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, tmpObj, NULL), envPtr); + TclEmitOpcode( INST_GT, envPtr); + offset = CurrentOffset(envPtr); + TclEmitInstInt1( INST_JUMP_TRUE1, 0, envPtr); + TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf( + "list doesn't contain element %d", idx1), NULL), envPtr); + CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0, + Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}")); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset, + envPtr->codeStart + offset + 1); + TclAdjustStackDepth(-1, envPtr); + } + TclEmitOpcode( INST_DUP, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr); + TclEmitInt4( idx1 - 1, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitInstInt4( INST_LIST_RANGE_IMM, idx2 + 1, envPtr); + TclEmitInt4( INDEX_END, envPtr); + TclEmitInstInt4( INST_REVERSE, 3, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + TclEmitInstInt4( INST_REVERSE, 2, envPtr); + TclEmitOpcode( INST_LIST_CONCAT, envPtr); + goto done; + + /* + * Clean up the allocated memory. + */ + + done: + if (tmpObj != NULL) { + Tcl_DecrRefCount(tmpObj); } return TCL_OK; } @@ -1791,6 +1956,28 @@ TclCompileNamespaceCodeCmd( } int +TclCompileNamespaceOriginCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + Tcl_Token *tokenPtr; + DefineLineInformation; /* TIP #280 */ + + if (parsePtr->numWords != 2) { + return TCL_ERROR; + } + tokenPtr = TokenAfter(parsePtr->tokenPtr); + + CompileWord(envPtr, tokenPtr, interp, 1); + TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr); + return TCL_OK; +} + +int TclCompileNamespaceQualifiersCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command @@ -2367,7 +2554,7 @@ TclCompileReturnCmd( CompileWord(envPtr, optsTokenPtr, interp, 2); CompileWord(envPtr, msgTokenPtr, interp, 3); - TclEmitOpcode(INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } @@ -2381,6 +2568,10 @@ TclCompileReturnCmd( * Scan through the return options. If any are unknown at compile time, * there is no value in bytecompiling. Save the option values known in an * objv array for merging into a return options dictionary. + * + * TODO: There is potential for improvement if all option keys are known + * at compile time and all option values relating to '-code' and '-level' + * are known at compile time. */ for (objc = 0; objc < numOptionWords; objc++) { @@ -2388,7 +2579,7 @@ TclCompileReturnCmd( Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { /* - * Non-literal, so punt to run-time. + * Non-literal, so punt to run-time assembly of the dictionary. */ for (; objc>=0 ; objc--) { @@ -2509,7 +2700,7 @@ TclCompileReturnCmd( * Issue the RETURN itself. */ - TclEmitOpcode(INST_RETURN_STK, envPtr); + TclEmitInvoke(envPtr, INST_RETURN_STK); return TCL_OK; } @@ -2521,6 +2712,23 @@ CompileReturnInternal( int level, Tcl_Obj *returnOpts) { + if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) { + ExceptionRange *rangePtr; + ExceptionAux *exceptAux; + + rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux); + if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) { + TclCleanupStackForBreakContinue(envPtr, exceptAux); + if (code == TCL_BREAK) { + TclAddLoopBreakFixup(envPtr, exceptAux); + } else { + TclAddLoopContinueFixup(envPtr, exceptAux); + } + Tcl_DecrRefCount(returnOpts); + return; + } + } + TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr); TclEmitInstInt4(op, code, envPtr); TclEmitInt4(level, envPtr); @@ -2831,6 +3039,41 @@ IndexTailVarIfKnown( return localIndex; } +/* + * ---------------------------------------------------------------------- + * + * TclCompileObjectNextCmd, TclCompileObjectSelfCmd -- + * + * Compilations of the TclOO utility commands [next] and [self]. + * + * ---------------------------------------------------------------------- + */ + +int +TclCompileObjectNextCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr = parsePtr->tokenPtr; + int i; + + if (parsePtr->numWords > 255) { + return TCL_ERROR; + } + + for (i=0 ; i<parsePtr->numWords ; i++) { + CompileWord(envPtr, tokenPtr, interp, i); + tokenPtr = TokenAfter(tokenPtr); + } + TclEmitInstInt1( INST_TCLOO_NEXT, i, envPtr); + return TCL_OK; +} + int TclCompileObjectSelfCmd( Tcl_Interp *interp, /* Used for error reporting. */ diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 96d691d..8e422c1 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -17,6 +17,7 @@ #include "tclInt.h" #include "tclCompile.h" +#include "tclStringTrim.h" /* * Prototypes for procedures defined later in this file: @@ -103,6 +104,61 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));} #define STORE(idx) \ if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} +#define INVOKE(name) \ + TclEmitInvoke(envPtr,INST_##name) + +#define INDEX_END (-2) + +/* + *---------------------------------------------------------------------- + * + * GetIndexFromToken -- + * + * Parse a token and get the encoded version of the index (as understood + * by TEBC), assuming it is at all knowable at compile time. Only handles + * indices that are integers or 'end' or 'end-integer'. + * + * Returns: + * TCL_OK if parsing succeeded, and TCL_ERROR if it failed. + * + * Side effects: + * Sets *index to the index value if successful. + * + *---------------------------------------------------------------------- + */ + +static inline int +GetIndexFromToken( + Tcl_Token *tokenPtr, + int *index) +{ + Tcl_Obj *tmpObj = Tcl_NewObj(); + int result, idx; + + if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { + Tcl_DecrRefCount(tmpObj); + return TCL_ERROR; + } + + result = TclGetIntFromObj(NULL, tmpObj, &idx); + if (result == TCL_OK) { + if (idx < 0) { + result = TCL_ERROR; + } + } else { + result = TclGetIntForIndexM(NULL, tmpObj, INDEX_END, &idx); + if (result == TCL_OK && idx > INDEX_END) { + result = TCL_ERROR; + } + } + Tcl_DecrRefCount(tmpObj); + + if (result == TCL_OK) { + *index = idx; + } + + return result; +} /* *---------------------------------------------------------------------- @@ -567,8 +623,7 @@ TclCompileStringRangeCmd( { DefineLineInformation; /* TIP #280 */ Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr; - Tcl_Obj *tmpObj; - int idx1, idx2, result; + int idx1, idx2; if (parsePtr->numWords != 4) { return TCL_ERROR; @@ -578,50 +633,13 @@ TclCompileStringRangeCmd( toTokenPtr = TokenAfter(fromTokenPtr); /* - * Parse the first index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). + * Parse the two indices. */ - tmpObj = Tcl_NewObj(); - result = TCL_ERROR; - if (TclWordKnownAtCompileTime(fromTokenPtr, tmpObj)) { - if (TclGetIntFromObj(NULL, tmpObj, &idx1) == TCL_OK) { - if (idx1 >= 0) { - result = TCL_OK; - } - } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx1) == TCL_OK) { - if (idx1 <= -2) { - result = TCL_OK; - } - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(fromTokenPtr, &idx1) != TCL_OK) { goto nonConstantIndices; } - - /* - * Parse the second index. Will only compile if it is constant and not an - * _integer_ less than zero (since we reserve negative indices here for - * end-relative indexing). - */ - - tmpObj = Tcl_NewObj(); - result = TCL_ERROR; - if (TclWordKnownAtCompileTime(toTokenPtr, tmpObj)) { - if (TclGetIntFromObj(NULL, tmpObj, &idx2) == TCL_OK) { - if (idx2 >= 0) { - result = TCL_OK; - } - } else if (TclGetIntForIndexM(NULL, tmpObj, -2, &idx2) == TCL_OK) { - if (idx2 <= -2) { - result = TCL_OK; - } - } - } - TclDecrRefCount(tmpObj); - if (result != TCL_OK) { + if (GetIndexFromToken(toTokenPtr, &idx2) != TCL_OK) { goto nonConstantIndices; } @@ -644,6 +662,285 @@ TclCompileStringRangeCmd( OP( STR_RANGE); return TCL_OK; } + +int +TclCompileStringReplaceCmd( + Tcl_Interp *interp, /* Tcl interpreter for context. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the + * command. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds the resulting instructions. */ +{ + Tcl_Token *tokenPtr, *valueTokenPtr, *replacementTokenPtr = NULL; + DefineLineInformation; /* TIP #280 */ + int idx1, idx2; + + if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { + return TCL_ERROR; + } + valueTokenPtr = TokenAfter(parsePtr->tokenPtr); + if (parsePtr->numWords == 5) { + tokenPtr = TokenAfter(valueTokenPtr); + tokenPtr = TokenAfter(tokenPtr); + replacementTokenPtr = TokenAfter(tokenPtr); + } + + /* + * Parse the indices. Will only compile special cases if both are + * constants and not an _integer_ less than zero (since we reserve + * negative indices here for end-relative indexing) or an end-based index + * greater than 'end' itself. + */ + + tokenPtr = TokenAfter(valueTokenPtr); + if (GetIndexFromToken(tokenPtr, &idx1) != TCL_OK) { + goto genericReplace; + } + + tokenPtr = TokenAfter(tokenPtr); + if (GetIndexFromToken(tokenPtr, &idx2) != TCL_OK) { + goto genericReplace; + } + + /* + * We handle these replacements specially: first character (where + * idx1=idx2=0) and last character (where idx1=idx2=INDEX_END). Anything + * else and the semantics get rather screwy. + */ + + if (idx1 == 0 && idx2 == 0) { + int notEq, end; + + /* + * Just working with the first character. + */ + + CompileWord(envPtr, valueTokenPtr, interp, 1); + if (replacementTokenPtr == NULL) { + /* Drop first */ + OP44( STR_RANGE_IMM, 1, INDEX_END); + return TCL_OK; + } + /* Replace first */ + CompileWord(envPtr, replacementTokenPtr, interp, 4); + OP4( OVER, 1); + PUSH( ""); + OP( STR_EQ); + JUMP1( JUMP_FALSE, notEq); + OP( POP); + JUMP1( JUMP, end); + FIXJUMP1(notEq); + TclAdjustStackDepth(1, envPtr); + OP4( REVERSE, 2); + OP44( STR_RANGE_IMM, 1, INDEX_END); + OP1( STR_CONCAT1, 2); + FIXJUMP1(end); + return TCL_OK; + + } else if (idx1 == INDEX_END && idx2 == INDEX_END) { + int notEq, end; + + /* + * Just working with the last character. + */ + + CompileWord(envPtr, valueTokenPtr, interp, 1); + if (replacementTokenPtr == NULL) { + /* Drop last */ + OP44( STR_RANGE_IMM, 0, INDEX_END-1); + return TCL_OK; + } + /* Replace last */ + CompileWord(envPtr, replacementTokenPtr, interp, 4); + OP4( OVER, 1); + PUSH( ""); + OP( STR_EQ); + JUMP1( JUMP_FALSE, notEq); + OP( POP); + JUMP1( JUMP, end); + FIXJUMP1(notEq); + TclAdjustStackDepth(1, envPtr); + OP4( REVERSE, 2); + OP44( STR_RANGE_IMM, 0, INDEX_END-1); + OP4( REVERSE, 2); + OP1( STR_CONCAT1, 2); + FIXJUMP1(end); + return TCL_OK; + + } else { + /* + * Need to process indices at runtime. This could be because the + * indices are not constants, or because we need to resolve them to + * absolute indices to work out if a replacement is going to happen. + * In any case, to runtime it is. + */ + + genericReplace: + CompileWord(envPtr, valueTokenPtr, interp, 1); + tokenPtr = TokenAfter(valueTokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 3); + if (replacementTokenPtr != NULL) { + CompileWord(envPtr, replacementTokenPtr, interp, 4); + } else { + PUSH( ""); + } + OP( STR_REPLACE); + return TCL_OK; + } +} + +int +TclCompileStringTrimLCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM_LEFT); + return TCL_OK; +} + +int +TclCompileStringTrimRCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM_RIGHT); + return TCL_OK; +} + +int +TclCompileStringTrimCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2 && parsePtr->numWords != 3) { + return TCL_ERROR; + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + if (parsePtr->numWords == 3) { + tokenPtr = TokenAfter(tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 2); + } else { + PushLiteral(envPtr, DEFAULT_TRIM_SET, strlen(DEFAULT_TRIM_SET)); + } + OP( STR_TRIM); + return TCL_OK; +} + +int +TclCompileStringToUpperCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_UPPER); + return TCL_OK; +} + +int +TclCompileStringToLowerCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_LOWER); + return TCL_OK; +} + +int +TclCompileStringToTitleCmd( + Tcl_Interp *interp, /* Used for error reporting. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ +{ + DefineLineInformation; /* TIP #280 */ + Tcl_Token *tokenPtr; + + if (parsePtr->numWords != 2) { + return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr); + } + + tokenPtr = TokenAfter(parsePtr->tokenPtr); + CompileWord(envPtr, tokenPtr, interp, 1); + OP( STR_TITLE); + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -754,7 +1051,7 @@ TclSubstCompile( /* * Tricky point! If the first token does not result in a *guaranteed* push * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it - * is possible to get to an INST_CONCAT1 or INST_DONE without enough + * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for * identifying a script that could trigger this case. */ @@ -819,11 +1116,11 @@ TclSubstCompile( } while (count > 255) { - OP1( CONCAT1, 255); + OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( STR_CONCAT1, count); count = 1; } @@ -877,7 +1174,7 @@ TclSubstCompile( OP( END_CATCH); OP( RETURN_CODE_BRANCH); - /* ERROR -> reraise it */ + /* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */ OP( RETURN_STK); OP( NOP); @@ -943,7 +1240,7 @@ TclSubstCompile( (int) (CurrentOffset(envPtr) - okFixup.codeOffset)); } if (count > 1) { - OP1(CONCAT1, count); + OP1(STR_CONCAT1, count); count = 1; } @@ -956,11 +1253,11 @@ TclSubstCompile( } while (count > 255) { - OP1( CONCAT1, 255); + OP1( STR_CONCAT1, 255); count -= 254; } if (count > 1) { - OP1( CONCAT1, count); + OP1( STR_CONCAT1, count); } Tcl_FreeParse(&parse); @@ -1995,7 +2292,7 @@ TclCompileThrowCmd( OP( LIST_LENGTH); OP1( JUMP_FALSE1, 16); OP4( LIST, 2); - OP44( RETURN_IMM, 1, 0); + OP44( RETURN_IMM, TCL_ERROR, 0); TclAdjustStackDepth(2, envPtr); OP( POP); OP( POP); @@ -2004,7 +2301,7 @@ TclCompileThrowCmd( PUSH( "type must be non-empty list"); PUSH( "-errorcode {TCL OPERATION THROW BADEXCEPTION}"); } - OP44( RETURN_IMM, 1, 0); + OP44( RETURN_IMM, TCL_ERROR, 0); return TCL_OK; } @@ -2426,7 +2723,7 @@ IssueTryClausesInstructions( TclAdjustStackDepth(-1, envPtr); FIXJUMP1( dontChangeOptions); OP4( REVERSE, 2); - OP( RETURN_STK); + INVOKE( RETURN_STK); } JUMP4( JUMP, addrsToFix[i]); @@ -2445,7 +2742,7 @@ IssueTryClausesInstructions( OP( POP); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); + INVOKE( RETURN_STK); /* * Fix all the jumps from taken clauses to here (which is the end of the @@ -2754,7 +3051,7 @@ IssueTryClausesFinallyInstructions( FIXJUMP1( finalOK); LOAD( optionsVar); LOAD( resultVar); - OP( RETURN_STK); + INVOKE( RETURN_STK); return TCL_OK; } @@ -2813,7 +3110,7 @@ IssueTryFinallyInstructions( OP1( JUMP1, 7); FIXJUMP1( jumpOK); OP4( REVERSE, 2); - OP( RETURN_STK); + INVOKE( RETURN_STK); return TCL_OK; } @@ -3099,6 +3396,7 @@ TclCompileWhileCmd( } SetLineInformation(1); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); + TclClearNumConversion(envPtr); jumpDist = CurrentOffset(envPtr) - bodyCodeOffset; if (jumpDist > 127) { diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index d8e4d9f..94c1bd6 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2335,9 +2335,9 @@ CompileExprTree( */ if (numWords < 255) { - TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords); } else { - TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 151bfd3..0d57b3b 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -63,7 +63,7 @@ InstructionDesc const tclInstructionTable[] = { /* Pop the topmost stack object */ {"dup", 1, +1, 0, {OPERAND_NONE}}, /* Duplicate the topmost stack object and push the result */ - {"concat1", 2, INT_MIN, 1, {OPERAND_UINT1}}, + {"strcat", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Concatenate the top op1 items and push result */ {"invokeStk1", 2, INT_MIN, 1, {OPERAND_UINT1}}, /* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */ @@ -493,6 +493,7 @@ InstructionDesc const tclInstructionTable[] = { * qualified version, or produces the empty string if no such command * exists. Never generates errors. * Stack: ... cmdName => ... fullCmdName */ + {"tclooSelf", 1, +1, 0, {OPERAND_NONE}}, /* Push the identity of the current TclOO object (i.e., the name of * its current public access command) on the stack. */ @@ -545,6 +546,81 @@ InstructionDesc const tclInstructionTable[] = { /* Drops an element from the auxiliary stack, popping stack elements * until the matching stack depth is reached. */ + /* New foreach implementation */ + {"foreach_start", 5, +2, 1, {OPERAND_AUX4}}, + /* Initialize execution of a foreach loop. Operand is aux data index + * of the ForeachInfo structure for the foreach command. It pushes 2 + * elements which hold runtime params for foreach_step, they are later + * dropped by foreach_end together with the value lists. NOTE that the + * iterator-tracker and info reference must not be passed to bytecodes + * that handle normal Tcl values. NOTE that this instruction jumps to + * the foreach_step instruction paired with it; the stack info below + * is only nominal. + * Stack: ... listObjs... => ... listObjs... iterTracker info */ + {"foreach_step", 1, 0, 0, {OPERAND_NONE}}, + /* "Step" or begin next iteration of foreach loop. Assigns to foreach + * iteration variables. May jump to straight after the foreach_start + * that pushed the iterTracker and info values. MUST be followed + * immediately by a foreach_end. + * Stack: ... listObjs... iterTracker info => + * ... listObjs... iterTracker info */ + {"foreach_end", 1, 0, 0, {OPERAND_NONE}}, + /* Clean up a foreach loop by dropping the info value, the tracker + * value and the lists that were being iterated over. + * Stack: ... listObjs... iterTracker info => ... */ + {"lmap_collect", 1, -1, 0, {OPERAND_NONE}}, + /* Appends the value at the top of the stack to the list located on + * the stack the "other side" of the foreach-related values. + * Stack: ... collector listObjs... iterTracker info value => + * ... collector listObjs... iterTracker info */ + + {"strtrim", 1, -1, 0, {OPERAND_NONE}}, + /* [string trim] core: removes the characters (designated by the value + * at the top of the stack) from both ends of the string and pushes + * the resulting string. + * Stack: ... string charset => ... trimmedString */ + {"strtrimLeft", 1, -1, 0, {OPERAND_NONE}}, + /* [string trimleft] core: removes the characters (designated by the + * value at the top of the stack) from the left of the string and + * pushes the resulting string. + * Stack: ... string charset => ... trimmedString */ + {"strtrimRight", 1, -1, 0, {OPERAND_NONE}}, + /* [string trimright] core: removes the characters (designated by the + * value at the top of the stack) from the right of the string and + * pushes the resulting string. + * Stack: ... string charset => ... trimmedString */ + + {"concatStk", 5, INT_MIN, 1, {OPERAND_UINT4}}, + /* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd + * is number of values to concatenate. + * Operation: push concat(stk1 stk2 ... stktop) */ + + {"strcaseUpper", 1, 0, 0, {OPERAND_NONE}}, + /* [string toupper] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strcaseLower", 1, 0, 0, {OPERAND_NONE}}, + /* [string tolower] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strcaseTitle", 1, 0, 0, {OPERAND_NONE}}, + /* [string totitle] core: converts whole string to upper case using + * the default (extended "C" locale) rules. + * Stack: ... string => ... newString */ + {"strreplace", 1, -3, 0, {OPERAND_NONE}}, + /* [string replace] core: replaces a non-empty range of one string + * with the contents of another. + * Stack: ... string fromIdx toIdx replacement => ... newString */ + + {"originCmd", 1, 0, 0, {OPERAND_NONE}}, + /* Reports which command was the origin (via namespace import chain) + * of the command named on the top of the stack. + * Stack: ... cmdName => ... fullOriginalCmdName */ + + {"tclooNext", 2, INT_MIN, 1, {OPERAND_UINT1}}, + /* Push the identity of the current TclOO object (i.e., the name of + * its current public access command) on the stack. */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; @@ -736,7 +812,9 @@ TclSetByteCodeFromAny( * instruction generator boundaries. */ - TclOptimizeBytecode(&compEnv); + if (iPtr->extra.optimizer) { + (iPtr->extra.optimizer)(&compEnv); + } /* * Invoke the compilation hook procedure if one exists. @@ -1691,7 +1769,7 @@ TclCompileInvocation( int numWords, CompileEnv *envPtr) { - int wordIdx = 0; + int wordIdx = 0, depth = TclGetStackDepth(envPtr); DefineLineInformation; if (cmdObj) { @@ -1720,10 +1798,11 @@ TclCompileInvocation( } if (wordIdx <= 255) { - TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx); } else { - TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx); } + TclCheckStackDepth(depth+1, envPtr); } static void @@ -1736,8 +1815,8 @@ CompileExpanded( { int wordIdx = 0; DefineLineInformation; - - + int depth = TclGetStackDepth(envPtr); + StartExpanding(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1769,24 +1848,21 @@ CompileExpanded( } /* - * The stack depth during argument expansion can only be - * managed at runtime, as the number of elements in the - * expanded lists is not known at compile time. We adjust here - * the stack depth estimate so that it is correct after the - * command with expanded arguments returns. + * The stack depth during argument expansion can only be managed at + * runtime, as the number of elements in the expanded lists is not known + * at compile time. We adjust here the stack depth estimate so that it is + * correct after the command with expanded arguments returns. * - * The end effect of this command's invocation is that all the - * words of the command are popped from the stack, and the - * result is pushed: the stack top changes by (1-wordIdx). + * The end effect of this command's invocation is that all the words of + * the command are popped from the stack, and the result is pushed: the + * stack top changes by (1-wordIdx). * - * Note that the estimates are not correct while the command - * is being prepared and run, INST_EXPAND_STKTOP is not - * stack-neutral in general. + * Note that the estimates are not correct while the command is being + * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general. */ - TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); - envPtr->expandCount--; - TclAdjustStackDepth(1 - wordIdx, envPtr); + TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx); + TclCheckStackDepth(depth+1, envPtr); } static int @@ -1798,10 +1874,11 @@ CompileCmdCompileProc( { int unwind = 0, incrOffset = -1; DefineLineInformation; + int depth = TclGetStackDepth(envPtr); /* - * Emit of the INST_START_CMD instruction is controlled by - * the value of envPtr->atCmdStart: + * Emit of the INST_START_CMD instruction is controlled by the value of + * envPtr->atCmdStart: * * atCmdStart == 2 : We are not using the INST_START_CMD instruction. * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. @@ -1832,9 +1909,10 @@ CompileCmdCompileProc( if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { if (incrOffset >= 0) { /* - * We successfully compiled a command. Increment the number - * of commands that start at the currently active INST_START_CMD. + * We successfully compiled a command. Increment the number of + * commands that start at the currently active INST_START_CMD. */ + unsigned char *incrPtr = envPtr->codeStart + incrOffset; unsigned char *startPtr = incrPtr - 5; @@ -1844,15 +1922,16 @@ CompileCmdCompileProc( TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1); } } + TclCheckStackDepth(depth+1, envPtr); return TCL_OK; } envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */ /* - * Throw out any line information generated by the failed - * compile attempt. + * Throw out any line information generated by the failed compile attempt. */ + while (mapPtr->nuloc - 1 > eclIndex) { mapPtr->nuloc--; ckfree(mapPtr->loc[mapPtr->nuloc].line); @@ -1860,11 +1939,11 @@ CompileCmdCompileProc( } /* - * Reset the index of next command. - * Toss out any from failed nested partial compiles. + * Reset the index of next command. Toss out any from failed nested + * partial compiles. */ - envPtr->numCommands = mapPtr->nuloc; + envPtr->numCommands = mapPtr->nuloc; return TCL_ERROR; } @@ -1886,7 +1965,8 @@ CompileCommandTokens( int *clNext = envPtr->clNext; int cmdIdx = envPtr->numCommands; int startCodeOffset = envPtr->codeNext - envPtr->codeStart; - + int depth = TclGetStackDepth(envPtr); + assert (parsePtr->numWords > 0); /* Pre-Compile */ @@ -1896,11 +1976,10 @@ CompileCommandTokens( parsePtr->commandStart - envPtr->source, startCodeOffset); /* - * TIP #280. Scan the words and compute the extended location - * information. The map first contain full per-word line - * information for use by the compiler. This is later replaced by - * a reduced form which signals non-literal words, stored in - * 'wlines'. + * TIP #280. Scan the words and compute the extended location information. + * The map first contain full per-word line information for use by the + * compiler. This is later replaced by a reduced form which signals + * non-literal words, stored in 'wlines'. */ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, @@ -1922,8 +2001,8 @@ CompileCommandTokens( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if (cmdPtr) { /* - * Found a command. Test the ways we can be told - * not to attempt to compile it. + * Found a command. Test the ways we can be told not to attempt + * to compile it. */ if ((cmdPtr->compileProc == NULL) || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION) @@ -1967,8 +2046,8 @@ CompileCommandTokens( (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); /* - * TIP #280: Free full form of per-word line data and insert the - * reduced form now + * TIP #280: Free full form of per-word line data and insert the reduced + * form now */ envPtr->line = cmdLine; @@ -1978,6 +2057,7 @@ CompileCommandTokens( eclPtr->loc[wlineat].line = wlines; eclPtr->loc[wlineat].next = NULL; + TclCheckStackDepth(depth, envPtr); return cmdIdx; } @@ -1997,6 +2077,7 @@ TclCompileScript( * Initial value of -1 indicates this routine * has not yet generated any bytecode. */ const char *p = script; /* Where we are in our compile. */ + int depth = TclGetStackDepth(envPtr); if (envPtr->iPtr == NULL) { Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv"); @@ -2053,20 +2134,20 @@ TclCompileScript( if (parse.numWords == 0) { /* - * The "command" parsed has no words. In this case - * we can skip the rest of the loop body. With no words, - * clearly CompileCommandTokens() has nothing to do. Since - * the parser aggressively sucks up leading comment and white - * space, including newlines, parse.commandStart must be - * pointing at either the end of script, or a command-terminating - * semi-colon. In either case, the TclAdvance*() calls have - * nothing to do. Finally, when no words are parsed, no - * tokens have been allocated at parse.tokenPtr so there's - * also nothing for Tcl_FreeParse() to do. + * The "command" parsed has no words. In this case we can skip + * the rest of the loop body. With no words, clearly + * CompileCommandTokens() has nothing to do. Since the parser + * aggressively sucks up leading comment and white space, + * including newlines, parse.commandStart must be pointing at + * either the end of script, or a command-terminating semi-colon. + * In either case, the TclAdvance*() calls have nothing to do. + * Finally, when no words are parsed, no tokens have been + * allocated at parse.tokenPtr so there's also nothing for + * Tcl_FreeParse() to do. * * The advantage of this shortcut is that CompileCommandTokens() - * can be written with an assumption that parse.numWords > 0, - * with the implication the CCT() always generates bytecode. + * can be written with an assumption that parse.numWords > 0, with + * the implication the CCT() always generates bytecode. */ continue; } @@ -2085,27 +2166,30 @@ TclCompileScript( if (lastCmdIdx == -1) { /* - * Compiling the script yielded no bytecode. The script must be - * all whitespace, comments, and empty commands. Such scripts - * are defined to successfully produce the empty string result, - * so we emit the simple bytecode that makes that happen. + * Compiling the script yielded no bytecode. The script must be all + * whitespace, comments, and empty commands. Such scripts are defined + * to successfully produce the empty string result, so we emit the + * simple bytecode that makes that happen. */ + PushStringLiteral(envPtr, ""); } else { /* * We compiled at least one command to bytecode. The routine * CompileCommandTokens() follows the bytecode of each compiled - * command with an INST_POP, so that stack balance is maintained - * when several commands are in sequence. (The result of each - * command is thrown away before moving on to the next command). - * For the last command compiled, we need to undo that INST_POP - * so that the result of the last command becomes the result of - * the script. The code here removes that trailing INST_POP. + * command with an INST_POP, so that stack balance is maintained when + * several commands are in sequence. (The result of each command is + * thrown away before moving on to the next command). For the last + * command compiled, we need to undo that INST_POP so that the result + * of the last command becomes the result of the script. The code + * here removes that trailing INST_POP. */ + envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--; envPtr->codeNext--; envPtr->currStackDepth++; } + TclCheckStackDepth(depth+1, envPtr); } /* @@ -2211,11 +2295,12 @@ TclCompileTokens( Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - int i, numObjsToConcat, length; + int i, numObjsToConcat, length, adjust; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; int *clPosition = NULL; + int depth = TclGetStackDepth(envPtr); /* * For the handling of continuation lines in literals we first check if @@ -2248,6 +2333,7 @@ TclCompileTokens( clPosition = ckalloc(maxNumCL * sizeof(int)); } + adjust = 0; Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; for ( ; count > 0; count--, tokenPtr++) { @@ -2291,6 +2377,7 @@ TclCompileTokens( clPosition[numCL] = clPos; numCL ++; } + adjust++; } break; @@ -2313,8 +2400,10 @@ TclCompileTokens( numCL = 0; } + envPtr->line += adjust; TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2, envPtr); + envPtr->line -= adjust; numObjsToConcat++; break; @@ -2365,11 +2454,11 @@ TclCompileTokens( */ while (numObjsToConcat > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); numObjsToConcat -= 254; /* concat pushes 1 obj, the result */ } if (numObjsToConcat > 1) { - TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr); } /* @@ -2389,6 +2478,7 @@ TclCompileTokens( if (maxNumCL) { ckfree(clPosition); } + TclCheckStackDepth(depth+1, envPtr); } /* @@ -2436,7 +2526,7 @@ TclCompileCmdWord( */ TclCompileTokens(interp, tokenPtr, count, envPtr); - TclEmitOpcode(INST_EVAL_STK, envPtr); + TclEmitInvoke(envPtr, INST_EVAL_STK); } } @@ -2500,11 +2590,11 @@ TclCompileExprWords( } concatItems = 2*numWords - 1; while (concatItems > 255) { - TclEmitInstInt1(INST_CONCAT1, 255, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr); concatItems -= 254; } if (concatItems > 1) { - TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr); + TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr); } TclEmitOpcode(INST_EXPR_STK, envPtr); } @@ -3333,9 +3423,9 @@ TclAddLoopContinueFixup( * * TclCleanupStackForBreakContinue -- * - * Ditch the extra elements from the auxiliary stack and the main - * stack. How to do this exactly depends on whether there are any - * elements on the auxiliary stack to pop. + * Ditch the extra elements from the auxiliary stack and the main stack. + * How to do this exactly depends on whether there are any elements on + * the auxiliary stack to pop. * * --------------------------------------------------------------------- */ @@ -3349,23 +3439,16 @@ TclCleanupStackForBreakContinue( int toPop = envPtr->expandCount - auxPtr->expandTarget; if (toPop > 0) { - while (toPop > 0) { + while (toPop --> 0) { TclEmitOpcode(INST_EXPAND_DROP, envPtr); - toPop--; } TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth, envPtr); - toPop = auxPtr->expandTargetDepth - auxPtr->stackDepth; - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } - } else { - toPop = envPtr->currStackDepth - auxPtr->stackDepth; - while (toPop > 0) { - TclEmitOpcode(INST_POP, envPtr); - toPop--; - } + envPtr->currStackDepth = auxPtr->expandTargetDepth; + } + toPop = envPtr->currStackDepth - auxPtr->stackDepth; + while (toPop --> 0) { + TclEmitOpcode(INST_POP, envPtr); } envPtr->currStackDepth = savedStackDepth; } @@ -3882,6 +3965,198 @@ TclFixupForwardJump( /* *---------------------------------------------------------------------- * + * TclEmitInvoke -- + * + * Emit one of the invoke-related instructions, wrapping it if necessary + * in code that ensures that any break or continue operation passing + * through it gets the stack unwinding correct, converting it into an + * internal jump if in an appropriate context. + * + * Results: + * None + * + * Side effects: + * Issues the jump with all correct stack management. May create another + * loop exception range; pointers to ExceptionRange and ExceptionAux + * structures should not be held across this call. + * + *---------------------------------------------------------------------- + */ + +void +TclEmitInvoke( + CompileEnv *envPtr, + int opcode, + ...) +{ + va_list argList; + ExceptionRange *rangePtr; + ExceptionAux *auxBreakPtr, *auxContinuePtr; + int arg1, arg2, wordCount = 0, expandCount = 0; + int loopRange = 0, breakRange = 0, continueRange = 0; + int cleanup, depth = TclGetStackDepth(envPtr); + + /* + * Parse the arguments. + */ + + va_start(argList, opcode); + switch (opcode) { + case INST_INVOKE_STK1: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_STK4: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + break; + case INST_INVOKE_REPLACE: + arg1 = va_arg(argList, int); + arg2 = va_arg(argList, int); + wordCount = arg1 + arg2 - 1; + cleanup = arg1 + 1; + break; + default: + Tcl_Panic("unexpected opcode"); + case INST_EVAL_STK: + wordCount = cleanup = 1; + arg1 = arg2 = 0; + break; + case INST_RETURN_STK: + wordCount = cleanup = 2; + arg1 = arg2 = 0; + break; + case INST_INVOKE_EXPANDED: + wordCount = arg1 = cleanup = va_arg(argList, int); + arg2 = 0; + expandCount = 1; + break; + } + va_end(argList); + + /* + * Determine if we need to handle break and continue exceptions with a + * special handling exception range (so that we can correctly unwind the + * stack). + * + * These must be done separately; they can be different (especially for + * calls from inside a [for] increment clause). + */ + + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxBreakPtr = NULL; + } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount + && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) { + auxBreakPtr = NULL; + } else { + breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } + + rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, + &auxContinuePtr); + if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { + auxContinuePtr = NULL; + } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount + && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) { + auxContinuePtr = NULL; + } else { + continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; + } + + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr); + ExceptionRangeStarts(envPtr, loopRange); + } + + /* + * Issue the invoke itself. + */ + + switch (opcode) { + case INST_INVOKE_STK1: + TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr); + break; + case INST_INVOKE_STK4: + TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr); + break; + case INST_INVOKE_EXPANDED: + TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); + envPtr->expandCount--; + TclAdjustStackDepth(1 - arg1, envPtr); + break; + case INST_EVAL_STK: + TclEmitOpcode(INST_EVAL_STK, envPtr); + break; + case INST_RETURN_STK: + TclEmitOpcode(INST_RETURN_STK, envPtr); + break; + case INST_INVOKE_REPLACE: + TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr); + TclEmitInt1(arg2, envPtr); + TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */ + break; + } + + /* + * If we're generating a special wrapper exception range, we need to + * finish that up now. + */ + + if (auxBreakPtr != NULL || auxContinuePtr != NULL) { + int savedStackDepth = envPtr->currStackDepth; + int savedExpandCount = envPtr->expandCount; + JumpFixup nonTrapFixup; + + if (auxBreakPtr != NULL) { + auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; + } + if (auxContinuePtr != NULL) { + auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange; + } + + ExceptionRangeEnds(envPtr, loopRange); + TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup); + + /* + * Careful! When generating these stack unwinding sequences, the depth + * of stack in the cases where they are taken is not the same as if + * the exception is not taken. + */ + + if (auxBreakPtr != NULL) { + TclAdjustStackDepth(-1, envPtr); + + ExceptionRangeTarget(envPtr, loopRange, breakOffset); + TclCleanupStackForBreakContinue(envPtr, auxBreakPtr); + TclAddLoopBreakFixup(envPtr, auxBreakPtr); + TclAdjustStackDepth(1, envPtr); + + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + if (auxContinuePtr != NULL) { + TclAdjustStackDepth(-1, envPtr); + + ExceptionRangeTarget(envPtr, loopRange, continueOffset); + TclCleanupStackForBreakContinue(envPtr, auxContinuePtr); + TclAddLoopContinueFixup(envPtr, auxContinuePtr); + TclAdjustStackDepth(1, envPtr); + + envPtr->currStackDepth = savedStackDepth; + envPtr->expandCount = savedExpandCount; + } + + TclFinalizeLoopExceptionRange(envPtr, loopRange); + TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127); + } + TclCheckStackDepth(depth+1-cleanup, envPtr); +} + +/* + *---------------------------------------------------------------------- + * * TclGetInstructionTable -- * * Returns a pointer to the table describing Tcl bytecode instructions. diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 03188df..525c87a 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -529,7 +529,7 @@ typedef struct ByteCode { #define INST_PUSH4 2 #define INST_POP 3 #define INST_DUP 4 -#define INST_CONCAT1 5 +#define INST_STR_CONCAT1 5 #define INST_INVOKE_STK1 6 #define INST_INVOKE_STK4 7 #define INST_EVAL_STK 8 @@ -603,8 +603,8 @@ typedef struct ByteCode { #define INST_CONTINUE 66 /* Opcodes 67 to 68 */ -#define INST_FOREACH_START4 67 -#define INST_FOREACH_STEP4 68 +#define INST_FOREACH_START4 67 /* DEPRECATED */ +#define INST_FOREACH_STEP4 68 /* DEPRECATED */ /* Opcodes 69 to 72 */ #define INST_BEGIN_CATCH4 69 @@ -768,6 +768,8 @@ typedef struct ByteCode { #define INST_INFO_LEVEL_NUM 152 #define INST_INFO_LEVEL_ARGS 153 #define INST_RESOLVE_COMMAND 154 + +/* For compilation relating to TclOO */ #define INST_TCLOO_SELF 155 #define INST_TCLOO_CLASS 156 #define INST_TCLOO_NS 157 @@ -785,8 +787,30 @@ typedef struct ByteCode { #define INST_EXPAND_DROP 165 +/* New foreach implementation */ +#define INST_FOREACH_START 166 +#define INST_FOREACH_STEP 167 +#define INST_FOREACH_END 168 +#define INST_LMAP_COLLECT 169 + +/* For compilation of [string trim] and related */ +#define INST_STR_TRIM 170 +#define INST_STR_TRIM_LEFT 171 +#define INST_STR_TRIM_RIGHT 172 + +#define INST_CONCAT_STK 173 + +#define INST_STR_UPPER 174 +#define INST_STR_LOWER 175 +#define INST_STR_TITLE 176 +#define INST_STR_REPLACE 177 + +#define INST_ORIGIN_COMMAND 178 + +#define INST_TCLOO_NEXT 179 + /* The last opcode */ -#define LAST_INST_OPCODE 165 +#define LAST_INST_OPCODE 179 /* * Table describing the Tcl bytecode instructions: their name (for displaying @@ -925,6 +949,7 @@ typedef struct ForeachInfo { } ForeachInfo; MODULE_SCOPE const AuxDataType tclForeachInfoType; +MODULE_SCOPE const AuxDataType tclNewForeachInfoType; #define FOREACHINFO(envPtr, index) \ ((ForeachInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData)) @@ -1044,6 +1069,7 @@ MODULE_SCOPE void TclDeleteLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); MODULE_SCOPE void TclEmitForwardJump(CompileEnv *envPtr, TclJumpType jumpType, JumpFixup *jumpFixupPtr); +MODULE_SCOPE void TclEmitInvoke(CompileEnv *envPtr, int opcode, ...); MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc, int catchOnly, ByteCode *codePtr); MODULE_SCOPE void TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr); @@ -1078,7 +1104,7 @@ MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif -MODULE_SCOPE void TclOptimizeBytecode(CompileEnv *envPtr); +MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -1093,8 +1119,6 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, int *isScalarPtr); -MODULE_SCOPE int TclRegisterLiteral(CompileEnv *envPtr, - char *bytes, int length, int flags); MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr); MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp, const char *name, Namespace *nsPtr); @@ -1188,6 +1212,21 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, (envPtr)->currStackDepth += (delta); \ } while (0) +#define TclGetStackDepth(envPtr) \ + ((envPtr)->currStackDepth) + +#define TclSetStackDepth(depth, envPtr) \ + (envPtr)->currStackDepth = (depth) + +#define TclCheckStackDepth(depth, envPtr) \ + do { \ + int dd = (depth); \ + if (dd != (envPtr)->currStackDepth) { \ + Tcl_Panic("bad stack depth computations: is %i, should be %i", \ + (envPtr)->currStackDepth, dd); \ + } \ + } while (0) + /* * Macro used to update the stack requirements. It is called by the macros * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. @@ -1328,6 +1367,18 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, } while (0) /* + * If the expr compiler finished with TRY_CONVERT, macro to remove it when the + * job is done by the following instruction. + */ + +#define TclClearNumConversion(envPtr) \ + do { \ + if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) { \ + envPtr->codeNext--; \ + } \ + } while (0) + +/* * Macros to update a (signed or unsigned) integer starting at a pointer. The * two variants depend on the number of bytes. The ANSI C "prototypes" for * these macros are: diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 4d40be1..830c998 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -31,6 +31,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -2479,10 +2483,8 @@ typedef struct TclStubs { void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */ } TclStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclStubs *tclStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index ad11785..9bb7a0c 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3179,9 +3179,7 @@ CompileToInvokedCommand( * Do the replacing dispatch. */ - TclEmitInstInt4(INST_INVOKE_REPLACE, parsePtr->numWords, envPtr); - TclEmitInt1(numWords+1, envPtr); - TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs. */ + TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1); } /* diff --git a/generic/tclEnv.c b/generic/tclEnv.c index b5ae6ea..8f51c1b 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -76,36 +76,56 @@ TclSetupEnv( Tcl_Interp *interp) /* Interpreter whose "env" array is to be * managed. */ { + Var *varPtr, *arrayPtr; + Tcl_Obj *varNamePtr; Tcl_DString envString; - char *p1, *p2; - int i; + Tcl_HashTable namesHash; + Tcl_HashEntry *hPtr; + Tcl_HashSearch search; /* * Synchronize the values in the environ array with the contents of the * Tcl "env" variable. To do this: - * 1) Remove the trace that fires when the "env" var is unset. - * 2) Unset the "env" variable. - * 3) If there are no environ variables, create an empty "env" array. - * Otherwise populate the array with current values. - * 4) Add a trace that synchronizes the "env" array. + * 1) Remove the trace that fires when the "env" var is updated. + * 2) Find the existing contents of the "env", storing in a hash table. + * 3) Create/update elements for each environ variable, removing + * elements from the hash table as we go. + * 4) Remove the elements for each remaining entry in the hash table, + * which must have existed before yet have no analog in the environ + * variable. + * 5) Add a trace that synchronizes the "env" array. */ Tcl_UntraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); - Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY); + /* + * Find out what elements are currently in the global env array. + */ - if (environ[0] == NULL) { - Tcl_Obj *varNamePtr; + TclNewLiteralStringObj(varNamePtr, "env"); + Tcl_IncrRefCount(varNamePtr); + Tcl_InitObjHashTable(&namesHash); + varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY, + /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + TclFindArrayPtrElements(varPtr, &namesHash); + + /* + * Go through the environment array and transfer its values into Tcl. At + * the same time, remove those elements we add/update from the hash table + * of existing elements, so that after this part processes, that table + * will hold just the parts to remove. + */ + + if (environ[0] != NULL) { + int i; - TclNewLiteralStringObj(varNamePtr, "env"); - Tcl_IncrRefCount(varNamePtr); - TclArraySet(interp, varNamePtr, NULL); - Tcl_DecrRefCount(varNamePtr); - } else { Tcl_MutexLock(&envMutex); for (i = 0; environ[i] != NULL; i++) { + Tcl_Obj *obj1, *obj2; + char *p1, *p2; + p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString); p2 = strchr(p1, '='); if (p2 == NULL) { @@ -119,12 +139,41 @@ TclSetupEnv( } p2++; p2[-1] = '\0'; - Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY); + obj1 = Tcl_NewStringObj(p1, -1); + obj2 = Tcl_NewStringObj(p2, -1); Tcl_DStringFree(&envString); + + Tcl_IncrRefCount(obj1); + Tcl_IncrRefCount(obj2); + Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY); + hPtr = Tcl_FindHashEntry(&namesHash, obj1); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } + Tcl_DecrRefCount(obj1); + Tcl_DecrRefCount(obj2); } Tcl_MutexUnlock(&envMutex); } + /* + * Delete those elements that existed in the array but which had no + * counterparts in the environment array. + */ + + for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL; + hPtr=Tcl_NextHashEntry(&search)) { + Tcl_Obj *elemName = Tcl_GetHashValue(hPtr); + + TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY); + } + Tcl_DeleteHashTable(&namesHash); + Tcl_DecrRefCount(varNamePtr); + + /* + * Re-establish the trace. + */ + Tcl_TraceVar2(interp, "env", NULL, TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL); @@ -565,7 +614,8 @@ EnvTraceProc( const char *value = TclGetEnv(name2, &valueString); if (value == NULL) { - return (char *) "no such variable"; + Tcl_UnsetVar2(interp, name1, name2, 0); + return NULL; } Tcl_SetVar2(interp, name1, name2, value, 0); Tcl_DStringFree(&valueString); diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 0ca393b..5b42124 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -174,29 +174,24 @@ static BuiltinFunc const tclBuiltinFuncTable[] = { typedef struct TEBCdata { ByteCode *codePtr; /* Constant until the BC returns */ /* -----------------------------------------*/ - const unsigned char *pc; /* These fields are used on return TO this */ - ptrdiff_t *catchTop; /* this level: they record the state when a */ - int cleanup; /* new codePtr was received for NR */ - Tcl_Obj *auxObjList; /* execution. */ - int checkInterp; - CmdFrame cmdFrame; + ptrdiff_t *catchTop; /* These fields are used on return TO this */ + Tcl_Obj *auxObjList; /* this level: they record the state when a */ + CmdFrame cmdFrame; /* new codePtr was received for NR */ + /* execution. */ void *stack[1]; /* Start of the actual combined catch and obj * stacks; the struct will be expanded as * necessary */ } TEBCdata; #define TEBC_YIELD() \ - do { \ - esPtr->tosPtr = tosPtr; \ - TD->pc = pc; \ - TD->cleanup = cleanup; \ - TclNRAddCallback(interp, TEBCresume, TD, INT2PTR(1), NULL, NULL); \ + do { \ + esPtr->tosPtr = tosPtr; \ + TclNRAddCallback(interp, TEBCresume, \ + TD, pc, INT2PTR(cleanup), NULL); \ } while (0) #define TEBC_DATA_DIG() \ do { \ - pc = TD->pc; \ - cleanup = TD->cleanup; \ tosPtr = esPtr->tosPtr; \ } while (0) @@ -293,12 +288,14 @@ VarHashCreateVar( switch (nCleanup) { \ case 1: goto cleanup1_pushObjResultPtr; \ case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ } \ } else { \ pc += (pcAdjustment); \ switch (nCleanup) { \ case 1: goto cleanup1; \ case 2: goto cleanup2; \ + case 0: break; \ } \ } \ } while (0) @@ -318,6 +315,70 @@ VarHashCreateVar( } \ } while (0) +#ifndef TCL_COMPILE_DEBUG +#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ + do { \ + pc += (pcAdjustment); \ + switch (*pc) { \ + case INST_JUMP_FALSE1: \ + NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + case INST_JUMP_TRUE1: \ + NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + case INST_JUMP_FALSE4: \ + NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + case INST_JUMP_TRUE4: \ + NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + default: \ + if ((condition) < 0) { \ + TclNewIntObj(objResultPtr, -1); \ + } else { \ + objResultPtr = TCONST((condition) > 0); \ + } \ + NEXT_INST_F(0, (cleanup), 1); \ + } \ + } while (0) +#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ + do { \ + pc += (pcAdjustment); \ + switch (*pc) { \ + case INST_JUMP_FALSE1: \ + NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ + case INST_JUMP_TRUE1: \ + NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ + case INST_JUMP_FALSE4: \ + NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ + case INST_JUMP_TRUE4: \ + NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ + default: \ + if ((condition) < 0) { \ + TclNewIntObj(objResultPtr, -1); \ + } else { \ + objResultPtr = TCONST((condition) > 0); \ + } \ + NEXT_INST_V(0, (cleanup), 1); \ + } \ + } while (0) +#else /* TCL_COMPILE_DEBUG */ +#define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \ + do{ \ + if ((condition) < 0) { \ + TclNewIntObj(objResultPtr, -1); \ + } else { \ + objResultPtr = TCONST((condition) > 0); \ + } \ + NEXT_INST_F((pcAdjustment), (cleanup), 1); \ + } while (0) +#define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ + do{ \ + if ((condition) < 0) { \ + TclNewIntObj(objResultPtr, -1); \ + } else { \ + objResultPtr = TCONST((condition) > 0); \ + } \ + NEXT_INST_V((pcAdjustment), (cleanup), 1); \ + } while (0) +#endif + /* * Macros used to cache often-referenced Tcl evaluation stack information * in local variables. Note that a DECACHE_STACK_INFO()-CACHE_STACK_INFO() @@ -360,6 +421,8 @@ VarHashCreateVar( #define CURR_DEPTH ((ptrdiff_t) (tosPtr - initTosPtr)) +#define STACK_BASE(esPtr) ((esPtr)->stackWords - 1) + /* * Macros used to trace instruction execution. The macros TRACE, * TRACE_WITH_OBJ, and O2S are only used inside TclNRExecuteByteCode. O2S is @@ -381,6 +444,8 @@ VarHashCreateVar( printf a; \ break; \ } +# define TRACE_ERROR(interp) \ + TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ while (traceInstructions) { \ fprintf(stdout, "%2d: %2d (%u) %s ", iPtr->numLevels, \ @@ -397,6 +462,7 @@ VarHashCreateVar( #else /* !TCL_COMPILE_DEBUG */ # define TRACE(a) # define TRACE_APPEND(a) +# define TRACE_ERROR(interp) # define TRACE_WITH_OBJ(a, objPtr) # define O2S(objPtr) #endif /* TCL_COMPILE_DEBUG */ @@ -451,7 +517,7 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? TCL_ERROR : \ + ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #else /* !TCL_WIDE_INT_IS_LONG */ #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \ @@ -471,7 +537,7 @@ VarHashCreateVar( (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \ ((((objPtr)->typePtr == NULL) && ((objPtr)->bytes == NULL)) || \ (((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \ - ? TCL_ERROR : \ + ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \ TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr))) #endif /* TCL_WIDE_INT_IS_LONG */ @@ -734,7 +800,8 @@ static Tcl_Obj ** StackAllocWords(Tcl_Interp *interp, int numWords); static Tcl_Obj ** StackReallocWords(Tcl_Interp *interp, int numWords); static Tcl_NRPostProc CopyCallback; static Tcl_NRPostProc ExprObjCallback; - +static Tcl_NRPostProc FinalizeOONext; +static Tcl_NRPostProc FinalizeOONextFilter; static Tcl_NRPostProc TEBCresume; /* @@ -885,7 +952,7 @@ TclCreateExecEnv( esPtr->nextPtr = NULL; esPtr->markerPtr = NULL; esPtr->endPtr = &esPtr->stackWords[size-1]; - esPtr->tosPtr = &esPtr->stackWords[-1]; + esPtr->tosPtr = STACK_BASE(esPtr); Tcl_MutexLock(&execMutex); if (!execInitialized) { @@ -1106,8 +1173,8 @@ GrowEvaluationStack( if (esPtr->nextPtr) { oldPtr = esPtr; esPtr = oldPtr->nextPtr; - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; - if (esPtr->markerPtr || (esPtr->tosPtr != &esPtr->stackWords[-1])) { + currElems = esPtr->endPtr - STACK_BASE(esPtr); + if (esPtr->markerPtr || (esPtr->tosPtr != STACK_BASE(esPtr))) { Tcl_Panic("STACK: Stack after current is in use"); } if (esPtr->nextPtr) { @@ -1119,7 +1186,7 @@ GrowEvaluationStack( DeleteExecStack(esPtr); esPtr = oldPtr; } else { - currElems = esPtr->endPtr - &esPtr->stackWords[-1]; + currElems = esPtr->endPtr - STACK_BASE(esPtr); } /* @@ -1273,10 +1340,10 @@ TclStackFree( while (esPtr->nextPtr) { esPtr = esPtr->nextPtr; } - esPtr->tosPtr = &esPtr->stackWords[-1]; + esPtr->tosPtr = STACK_BASE(esPtr); while (esPtr->prevPtr) { ExecStack *tmpPtr = esPtr->prevPtr; - if (tmpPtr->tosPtr == &tmpPtr->stackWords[-1]) { + if (tmpPtr->tosPtr == STACK_BASE(tmpPtr)) { DeleteExecStack(tmpPtr); } else { break; @@ -1930,6 +1997,41 @@ TclIncrObj( /* *---------------------------------------------------------------------- * + * ArgumentBCEnter -- + * + * This is a helper for TclNRExecuteByteCode/TEBCresume that encapsulates + * a code sequence that is fairly common in the code but *not* commonly + * called. + * + * Results: + * None + * + * Side effects: + * May register information about the bytecode in the command frame. + * + *---------------------------------------------------------------------- + */ + +static void +ArgumentBCEnter( + Tcl_Interp *interp, + ByteCode *codePtr, + TEBCdata *tdPtr, + const unsigned char *pc, + int objc, + Tcl_Obj **objv) +{ + int cmd; + + if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { + TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd, + pc - codePtr->codeStart); + } +} + +/* + *---------------------------------------------------------------------- + * * TclNRExecuteByteCode -- * * This procedure executes the instructions of a ByteCode structure. It @@ -1962,10 +2064,6 @@ TclNRExecuteByteCode( * sizeof(void *); int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *); - if (iPtr->execEnvPtr->rewind) { - return TCL_ERROR; - } - codePtr->refCount++; /* @@ -1984,11 +2082,8 @@ TclNRExecuteByteCode( esPtr->tosPtr = initTosPtr; TD->codePtr = codePtr; - TD->pc = codePtr->codeStart; TD->catchTop = initCatchTop; - TD->cleanup = 0; TD->auxObjList = NULL; - TD->checkInterp = 0; /* * TIP #280: Initialize the frame. Do not push it yet: it will be pushed @@ -2017,8 +2112,8 @@ TclNRExecuteByteCode( * Push the callback for bytecode execution */ - TclNRAddCallback(interp, TEBCresume, TD, /*resume*/ INT2PTR(0), - NULL, NULL); + TclNRAddCallback(interp, TEBCresume, TD, /* pc */ NULL, + /* cleanup */ INT2PTR(0), NULL); return TCL_OK; } @@ -2074,9 +2169,6 @@ TEBCresume( #define auxObjList (TD->auxObjList) #define catchTop (TD->catchTop) #define codePtr (TD->codePtr) -#define checkInterp (TD->checkInterp) - /* Indicates when a check of interp readyness is - * necessary. Set by CACHE_STACK_INFO() */ /* * Globals: variables that store state, must remain valid at all times. @@ -2084,7 +2176,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ - const unsigned char *pc; /* The current program counter. */ + const unsigned char *pc = data[1]; + /* The current program counter. */ unsigned char inst; /* The currently running instruction */ /* @@ -2092,8 +2185,10 @@ TEBCresume( * executing an instruction. */ - int cleanup = 0; + int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; + int checkInterp; /* Indicates when a check of interp readyness + * is necessary. Set by CACHE_STACK_INFO() */ /* * Locals - variables that are used within opcodes or bounded sections of @@ -2118,17 +2213,26 @@ TEBCresume( TEBC_DATA_DIG(); #ifdef TCL_COMPILE_DEBUG - if (!data[1] && (tclTraceExec >= 2)) { + if (!pc && (tclTraceExec >= 2)) { PrintByteCodeInfo(codePtr); fprintf(stdout, " Starting stack top=%d\n", (int) CURR_DEPTH); fflush(stdout); } #endif - if (data[1] /* resume from invocation */) { + if (!pc) { + /* bytecode is starting from scratch */ + checkInterp = 0; + pc = codePtr->codeStart; + goto cleanup0; + } else { + /* resume from invocation */ + CACHE_STACK_INFO(); if (iPtr->execEnvPtr->rewind) { result = TCL_ERROR; + goto abnormalReturn; } + NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); if (bcFramePtr->cmdObj) { Tcl_DecrRefCount(bcFramePtr->cmdObj); @@ -2137,68 +2241,49 @@ TEBCresume( } iPtr->cmdFramePtr = bcFramePtr->nextPtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - TclArgumentBCRelease((Tcl_Interp *) iPtr, bcFramePtr); + TclArgumentBCRelease(interp, bcFramePtr); } if (codePtr->flags & TCL_BYTECODE_RECOMPILE) { iPtr->flags |= ERR_ALREADY_LOGGED; codePtr->flags &= ~TCL_BYTECODE_RECOMPILE; } - CACHE_STACK_INFO(); - if (result == TCL_OK) { - /* - * Push the call's object result and continue execution with the - * next instruction. - */ - - TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", - objc, cmdNameBuf), Tcl_GetObjResult(interp)); - - /* - * Reset the interp's result to avoid possible duplications of - * large objects [Bug 781585]. We do not call Tcl_ResetResult to - * avoid any side effects caused by the resetting of errorInfo and - * errorCode [Bug 804681], which are not needed here. We chose - * instead to manipulate the interp's object result directly. - * - * Note that the result object is now in objResultPtr, it keeps - * the refCount it had in its role of iPtr->objResultPtr. - */ - - objResultPtr = Tcl_GetObjResult(interp); - TclNewObj(objPtr); - Tcl_IncrRefCount(objPtr); - iPtr->objResultPtr = objPtr; -#ifndef TCL_COMPILE_DEBUG - if (*pc == INST_POP) { - TclDecrRefCount(objResultPtr); - NEXT_INST_V(1, cleanup, 0); - } -#endif - NEXT_INST_V(0, cleanup, -1); + if (result != TCL_OK) { + pc--; + goto processExceptionReturn; } /* - * Result not TCL_OK: fall through + * Push the call's object result and continue execution with the next + * instruction. */ - } - if (iPtr->execEnvPtr->rewind) { - result = TCL_ERROR; - goto abnormalReturn; - } + TRACE_WITH_OBJ(("%u => ... after \"%.20s\": TCL_OK, result=", + objc, cmdNameBuf), Tcl_GetObjResult(interp)); - if (result != TCL_OK) { - pc--; - goto processExceptionReturn; - } - - /* - * Loop executing instructions until a "done" instruction, a TCL_RETURN, - * or some error. - */ + /* + * Reset the interp's result to avoid possible duplications of large + * objects [Bug 781585]. We do not call Tcl_ResetResult to avoid any + * side effects caused by the resetting of errorInfo and errorCode + * [Bug 804681], which are not needed here. We chose instead to + * manipulate the interp's object result directly. + * + * Note that the result object is now in objResultPtr, it keeps the + * refCount it had in its role of iPtr->objResultPtr. + */ - goto cleanup0; + objResultPtr = Tcl_GetObjResult(interp); + TclNewObj(objPtr); + Tcl_IncrRefCount(objPtr); + iPtr->objResultPtr = objPtr; +#ifndef TCL_COMPILE_DEBUG + if (*pc == INST_POP) { + TclDecrRefCount(objResultPtr); + NEXT_INST_V(1, cleanup, 0); + } +#endif + NEXT_INST_V(0, cleanup, -1); + } /* * Targets for standard instruction endings; unrolled for speed in the @@ -2417,8 +2502,10 @@ TEBCresume( TRACE_APPEND(("ERROR: yield outside coroutine\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", -1)); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL); + CACHE_STACK_INFO(); goto gotError; } @@ -2436,11 +2523,7 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - int cmd; - if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); - } + ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } pc++; @@ -2463,7 +2546,9 @@ TEBCresume( TRACE(("%d => ERROR: tailcall in non-proc context\n", opnd)); Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc or lambda", -1)); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL); + CACHE_STACK_INFO(); goto gotError; } @@ -2541,7 +2626,7 @@ TEBCresume( case INST_OVER: opnd = TclGetUInt4AtPtr(pc+1); objResultPtr = OBJ_AT_DEPTH(opnd); - TRACE_WITH_OBJ(("=> "), objResultPtr); + TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_F(5, 0, 1); case INST_REVERSE: { @@ -2556,10 +2641,11 @@ TEBCresume( *b = tmpPtr; a++; b--; } + TRACE(("%u => OK\n", opnd)); NEXT_INST_F(5, 0, 0); } - case INST_CONCAT1: { + case INST_STR_CONCAT1: { int appendLen = 0; char *bytes, *p; Tcl_Obj **currPtr; @@ -2708,6 +2794,17 @@ TEBCresume( NEXT_INST_V(2, opnd, 1); } + case INST_CONCAT_STK: + /* + * Pop the opnd (objc) top stack elements, run through Tcl_ConcatObj, + * and then decrement their ref counts. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); + NEXT_INST_V(5, opnd, 1); + case INST_EXPAND_START: /* * Push an element to the auxObjList. This records the current @@ -2726,6 +2823,7 @@ TEBCresume( objPtr->internalRep.ptrAndLongRep.value = CURR_DEPTH; objPtr->length = 0; PUSH_TAUX_OBJ(objPtr); + TRACE(("=> mark depth as %d\n", (int) CURR_DEPTH)); NEXT_INST_F(1, 0, 0); case INST_EXPAND_DROP: @@ -2742,6 +2840,7 @@ TEBCresume( /* Ugly abuse! */ starting = 1; #endif + TRACE(("=> drop %d items\n", objc)); NEXT_INST_V(1, objc, 0); case INST_EXPAND_STKTOP: { @@ -2755,9 +2854,9 @@ TEBCresume( */ objPtr = OBJ_AT_TOS; + TRACE(("\"%.30s\" => ", O2S(objPtr))); if (TclListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) { - TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(objPtr)), - Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } (void) POP_OBJECT(); @@ -2801,6 +2900,7 @@ TEBCresume( PUSH_OBJECT(objv[i]); } + TRACE_APPEND(("OK\n")); Tcl_DecrRefCount(objPtr); NEXT_INST_F(5, 0, 0); } @@ -2893,11 +2993,7 @@ TEBCresume( iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - int cmd; - if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); - } + ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } DECACHE_STACK_INFO(); @@ -3042,11 +3138,7 @@ TEBCresume( bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - int cmd; - if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { - TclArgumentBCEnter((Tcl_Interp *) iPtr, objv, objc, - codePtr, bcFramePtr, cmd, pc - codePtr->codeStart); - } + ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); } iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = opnd; @@ -3145,7 +3237,7 @@ TEBCresume( varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr, opnd); if (varPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } cleanup = 1; @@ -3171,7 +3263,7 @@ TEBCresume( TCL_LEAVE_ERR_MSG, "read", /*createPart1*/0, /*createPart2*/1, &arrayPtr); if (!varPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } @@ -3198,7 +3290,7 @@ TEBCresume( part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (!objResultPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); @@ -3347,7 +3439,7 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } cleanup = ((part2Ptr == NULL)? 2 : 3); @@ -3397,7 +3489,7 @@ TEBCresume( varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", 1, 1, arrayPtr, opnd); if (!varPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } goto doCallPtrSetVar; @@ -3445,7 +3537,7 @@ TEBCresume( part1Ptr, part2Ptr, valuePtr, storeFlags, opnd); CACHE_STACK_INFO(); if (!objResultPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } #ifndef TCL_COMPILE_DEBUG @@ -3520,9 +3612,11 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (!varPtr) { + DECACHE_STACK_INFO(); Tcl_AddErrorInfo(interp, "\n (reading value of variable to increment)"); - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + CACHE_STACK_INFO(); + TRACE_ERROR(interp); Tcl_DecrRefCount(incrPtr); goto gotError; } @@ -3548,7 +3642,7 @@ TEBCresume( varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, arrayPtr, opnd); if (!varPtr) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); Tcl_DecrRefCount(incrPtr); goto gotError; } @@ -3660,8 +3754,7 @@ TEBCresume( TclNewLongObj(incrPtr, increment); if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } Tcl_DecrRefCount(incrPtr); @@ -3698,8 +3791,7 @@ TEBCresume( } if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) { Tcl_DecrRefCount(incrPtr); - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } Tcl_DecrRefCount(incrPtr); @@ -3710,8 +3802,7 @@ TEBCresume( CACHE_STACK_INFO(); Tcl_DecrRefCount(incrPtr); if (objResultPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } } @@ -3732,6 +3823,8 @@ TEBCresume( */ case INST_EXIST_SCALAR: + cleanup = 0; + pcAdjustment = 5; opnd = TclGetUInt4AtPtr(pc+1); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { @@ -3748,16 +3841,11 @@ TEBCresume( varPtr = NULL; } } - - /* - * Tricky! Arrays always exist. - */ - - objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(5, 0, 1); + goto afterExistsPeephole; case INST_EXIST_ARRAY: + cleanup = 1; + pcAdjustment = 5; opnd = TclGetUInt4AtPtr(pc+1); part2Ptr = OBJ_AT_TOS; arrayPtr = LOCAL(opnd); @@ -3768,7 +3856,7 @@ TEBCresume( if (TclIsVarArray(arrayPtr) && !ReadTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); if (!varPtr || !ReadTraced(varPtr)) { - goto doneExistArray; + goto afterExistsPeephole; } } varPtr = TclLookupArrayElement(interp, NULL, part2Ptr, 0, "access", @@ -3785,13 +3873,11 @@ TEBCresume( varPtr = NULL; } } - doneExistArray: - objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_F(5, 1, 1); + goto afterExistsPeephole; case INST_EXIST_ARRAY_STK: cleanup = 2; + pcAdjustment = 1; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ TRACE(("\"%.30s(%.30s)\" => ", O2S(part1Ptr), O2S(part2Ptr))); @@ -3799,6 +3885,7 @@ TEBCresume( case INST_EXIST_STK: cleanup = 1; + pcAdjustment = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ TRACE(("\"%.30s\" => ", O2S(part1Ptr))); @@ -3818,9 +3905,17 @@ TEBCresume( varPtr = NULL; } } - objResultPtr = TCONST(!varPtr || TclIsVarUndefined(varPtr) ? 0 : 1); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(1, cleanup, 1); + + /* + * Peep-hole optimisation: if you're about to jump, do jump from here. + */ + + afterExistsPeephole: { + int found = (varPtr && !TclIsVarUndefined(varPtr)); + + TRACE_APPEND(("%d\n", found ? 1 : 0)); + JUMP_PEEPHOLE_V(found, pcAdjustment, cleanup); + } /* * End of INST_EXIST instructions. @@ -3838,7 +3933,7 @@ TEBCresume( while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - TRACE(("%s %u\n", (flags?"normal":"noerr"), opnd)); + TRACE(("%s %u => ", (flags ? "normal" : "noerr"), opnd)); if (TclIsVarDirectUnsettable(varPtr) && !TclIsVarInHash(varPtr)) { /* * No errors, no traces, no searches: just make the variable cease @@ -3851,6 +3946,7 @@ TEBCresume( goto slowUnsetScalar; } varPtr->value.objPtr = NULL; + TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 0, 0); } @@ -3871,7 +3967,7 @@ TEBCresume( while (TclIsVarLink(arrayPtr)) { arrayPtr = arrayPtr->value.linkPtr; } - TRACE(("%s %u \"%.30s\"\n", + TRACE(("%s %u \"%.30s\" => ", (flags ? "normal" : "noerr"), opnd, O2S(part2Ptr))); if (TclIsVarArray(arrayPtr) && !UnsetTraced(arrayPtr)) { varPtr = VarHashFindVar(arrayPtr->value.tablePtr, part2Ptr); @@ -3887,12 +3983,14 @@ TEBCresume( goto slowUnsetArray; } varPtr->value.objPtr = NULL; + TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 1, 0); } else if (!varPtr && !(flags & TCL_LEAVE_ERR_MSG)) { /* * Don't need to do anything here. */ + TRACE_APPEND(("OK\n")); NEXT_INST_F(6, 1, 0); } } @@ -3916,7 +4014,7 @@ TEBCresume( cleanup = 2; part2Ptr = OBJ_AT_TOS; /* element name */ part1Ptr = OBJ_UNDER_TOS; /* array name */ - TRACE(("%s \"%.30s(%.30s)\"\n", (flags?"normal":"noerr"), + TRACE(("%s \"%.30s(%.30s)\" => ", (flags ? "normal" : "noerr"), O2S(part1Ptr), O2S(part2Ptr))); goto doUnsetStk; @@ -3925,7 +4023,8 @@ TEBCresume( cleanup = 1; part2Ptr = NULL; part1Ptr = OBJ_AT_TOS; /* variable name */ - TRACE(("%s \"%.30s\"\n", (flags?"normal":"noerr"), O2S(part1Ptr))); + TRACE(("%s \"%.30s\" => ", (flags ? "normal" : "noerr"), + O2S(part1Ptr))); doUnsetStk: DECACHE_STACK_INFO(); @@ -3934,11 +4033,12 @@ TEBCresume( goto errorInUnset; } CACHE_STACK_INFO(); + TRACE_APPEND(("OK\n")); NEXT_INST_V(2, cleanup, 0); errorInUnset: CACHE_STACK_INFO(); - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; /* @@ -3947,7 +4047,7 @@ TEBCresume( case INST_DICT_DONE: opnd = TclGetUInt4AtPtr(pc+1); - TRACE(("%u\n", opnd)); + TRACE(("%u => OK\n", opnd)); varPtr = LOCAL(opnd); while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; @@ -4000,8 +4100,7 @@ TEBCresume( TCL_GLOBAL_ONLY|TCL_TRACE_ARRAY), 1, opnd); CACHE_STACK_INFO(); if (result == TCL_ERROR) { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } } @@ -4034,7 +4133,7 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, part1Ptr, NULL, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/1, /*createPart2*/0, &arrayPtr); if (varPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } doArrayMake: @@ -4046,9 +4145,10 @@ TEBCresume( TclObjVarErrMsg(interp, part1Ptr, NULL, "array set", "variable isn't array", opnd); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL); - TRACE_APPEND(("ERROR: bad array ref: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + CACHE_STACK_INFO(); + TRACE_ERROR(interp); goto gotError; } TclSetVarArray(varPtr); @@ -4076,9 +4176,11 @@ TEBCresume( Namespace *savedNsPtr; case INST_UPVAR: - TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS); + TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1), + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); if (TclObjGetFrame(interp, OBJ_UNDER_TOS, &framePtr) == -1) { + TRACE_ERROR(interp); goto gotError; } @@ -4093,13 +4195,16 @@ TEBCresume( /*createPart2*/ 1, &varPtr); iPtr->varFramePtr = savedFramePtr; if (!otherPtr) { + TRACE_ERROR(interp); goto gotError; } goto doLinkVars; case INST_NSUPVAR: - TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS); + TRACE(("%d %.30s %.30s => ", TclGetInt4AtPtr(pc+1), + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); if (TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } @@ -4114,16 +4219,18 @@ TEBCresume( /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr->nsPtr = savedNsPtr; if (!otherPtr) { + TRACE_ERROR(interp); goto gotError; } goto doLinkVars; case INST_VARIABLE: - TRACE(("variable ")); + TRACE(("%d, %.30s => ", TclGetInt4AtPtr(pc+1), O2S(OBJ_AT_TOS))); otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL, (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); if (!otherPtr) { + TRACE_ERROR(interp); goto gotError; } @@ -4141,7 +4248,7 @@ TEBCresume( * if there are no errors; otherwise, let it handle the case. */ - opnd = TclGetInt4AtPtr(pc+1);; + opnd = TclGetInt4AtPtr(pc+1); varPtr = LOCAL(opnd); if ((varPtr != otherPtr) && !TclIsVarTraced(varPtr) && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) { @@ -4153,6 +4260,7 @@ TEBCresume( Var *linkPtr = varPtr->value.linkPtr; if (linkPtr == otherPtr) { + TRACE_APPEND(("already linked\n")); NEXT_INST_F(5, 1, 0); } if (TclIsVarInHash(linkPtr)) { @@ -4169,6 +4277,7 @@ TEBCresume( } } else if (TclPtrObjMakeUpvar(interp, otherPtr, NULL, 0, opnd) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } @@ -4177,6 +4286,7 @@ TEBCresume( * variables - and [variable] did not push it at all. */ + TRACE_APPEND(("link made\n")); NEXT_INST_F(5, 1, 0); } @@ -4223,31 +4333,29 @@ TEBCresume( doCondJump: valuePtr = OBJ_AT_TOS; + TRACE(("%d => ", jmpOffset[ + (*pc==INST_JUMP_FALSE1 || *pc==INST_JUMP_FALSE4) ? 0 : 1])); /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(interp, valuePtr, &b) != TCL_OK) { - TRACE_WITH_OBJ(("%d => ERROR: ", jmpOffset[ - ((*pc == INST_JUMP_FALSE1) || (*pc == INST_JUMP_FALSE4)) - ? 0 : 1]), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } #ifdef TCL_COMPILE_DEBUG if (b) { if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { - TRACE(("%d => %.20s true, new pc %u\n", jmpOffset[1], - O2S(valuePtr), + TRACE_APPEND(("%.20s true, new pc %u\n", O2S(valuePtr), (unsigned)(pc + jmpOffset[1] - codePtr->codeStart))); } else { - TRACE(("%d => %.20s true\n", jmpOffset[0], O2S(valuePtr))); + TRACE_APPEND(("%.20s true\n", O2S(valuePtr))); } } else { if ((*pc == INST_JUMP_TRUE1) || (*pc == INST_JUMP_TRUE4)) { - TRACE(("%d => %.20s false\n", jmpOffset[0], O2S(valuePtr))); + TRACE_APPEND(("%.20s false\n", O2S(valuePtr))); } else { - TRACE(("%d => %.20s false, new pc %u\n", jmpOffset[0], - O2S(valuePtr), + TRACE_APPEND(("%.20s false, new pc %u\n", O2S(valuePtr), (unsigned)(pc + jmpOffset[0] - codePtr->codeStart))); } } @@ -4266,7 +4374,7 @@ TEBCresume( opnd = TclGetInt4AtPtr(pc+1); jtPtr = (JumptableInfo *) codePtr->auxDataArrayPtr[opnd].clientData; - TRACE(("%d => %.20s ", opnd, O2S(OBJ_AT_TOS))); + TRACE(("%d \"%.20s\" => ", opnd, O2S(OBJ_AT_TOS))); hPtr = Tcl_FindHashEntry(&jtPtr->hashTable, TclGetString(OBJ_AT_TOS)); if (hPtr != NULL) { int jumpOffset = PTR2INT(Tcl_GetHashValue(hPtr)); @@ -4361,13 +4469,11 @@ TEBCresume( register CallFrame *framePtr = iPtr->varFramePtr; register CallFrame *rootFramePtr = iPtr->rootFramePtr; - valuePtr = OBJ_AT_TOS; - if (TclGetIntFromObj(interp, valuePtr, &level) != TCL_OK) { - TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), - Tcl_GetObjResult(interp)); + TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); + if (TclGetIntFromObj(interp, OBJ_AT_TOS, &level) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } - TRACE(("%d => ", level)); if (level <= 0) { level += framePtr->level; } @@ -4376,38 +4482,75 @@ TEBCresume( /* Empty loop body */ } if (framePtr == rootFramePtr) { - Tcl_AppendResult(interp, "bad level \"", TclGetString(valuePtr), - "\"", NULL); - TRACE_APPEND(("ERROR: bad level\n")); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(OBJ_AT_TOS))); + TRACE_ERROR(interp); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", - TclGetString(valuePtr), NULL); + TclGetString(OBJ_AT_TOS), NULL); + CACHE_STACK_INFO(); goto gotError; } objResultPtr = Tcl_NewListObj(framePtr->objc, framePtr->objv); TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } - case INST_RESOLVE_COMMAND: { - Tcl_Command cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); + { + Tcl_Command cmd, origCmd; + case INST_RESOLVE_COMMAND: + cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); TclNewObj(objResultPtr); if (cmd != NULL) { Tcl_GetCommandFullName(interp, cmd, objResultPtr); } TRACE_WITH_OBJ(("\"%.20s\" => ", O2S(OBJ_AT_TOS)), objResultPtr); NEXT_INST_F(1, 1, 1); + + case INST_ORIGIN_COMMAND: + TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); + cmd = Tcl_GetCommandFromObj(interp, OBJ_AT_TOS); + if (cmd == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid command name \"%s\"", TclGetString(OBJ_AT_TOS))); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(OBJ_AT_TOS), NULL); + CACHE_STACK_INFO(); + TRACE_APPEND(("ERROR: not command\n")); + goto gotError; + } + origCmd = TclGetOriginalCommand(cmd); + if (origCmd == NULL) { + origCmd = cmd; + } + TclNewObj(objResultPtr); + Tcl_GetCommandFullName(interp, origCmd, objResultPtr); + TRACE_APPEND(("\"%.30s\"", O2S(OBJ_AT_TOS))); + NEXT_INST_F(1, 1, 1); } - case INST_TCLOO_SELF: { - CallFrame *framePtr = iPtr->varFramePtr; + + /* + * ----------------------------------------------------------------- + * Start of TclOO support instructions. + */ + + { + Object *oPtr; + CallFrame *framePtr; CallContext *contextPtr; + case INST_TCLOO_SELF: + framePtr = iPtr->varFramePtr; if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { TRACE(("=> ERROR: no TclOO call context\n")); Tcl_SetObjResult(interp, Tcl_NewStringObj( "self may only be called from inside a method", -1)); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); + CACHE_STACK_INFO(); goto gotError; } contextPtr = framePtr->clientData; @@ -4419,9 +4562,109 @@ TEBCresume( objResultPtr = TclOOObjectName(interp, contextPtr->oPtr); TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); - } - { - Object *oPtr; + + case INST_TCLOO_NEXT: + opnd = TclGetUInt1AtPtr(pc+1); + framePtr = iPtr->varFramePtr; + TRACE(("%d => ", opnd)); + if (framePtr == NULL || + !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { + TRACE_APPEND(("ERROR: no TclOO call context\n")); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "next may only be called from inside a method", + -1)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); + CACHE_STACK_INFO(); + goto gotError; + } + contextPtr = framePtr->clientData; + + if (contextPtr->index+1 >= contextPtr->callPtr->numChain) { + /* + * We're at the end of the chain; generate an error message unless + * the interpreter is being torn down, in which case we might be + * getting here because of methods/destructors doing a [next] (or + * equivalent) unexpectedly. + */ + + const char *methodType; + + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + methodType = "constructor"; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + methodType = "destructor"; + } else { + methodType = "method"; + } + + TRACE_APPEND(("ERROR: no TclOO next impl\n")); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "no next %s implementation", methodType)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); + CACHE_STACK_INFO(); + goto gotError; + } + +#ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { + int i; + + if (traceInstructions) { + strncpy(cmdNameBuf, TclGetString(objv[0]), 20); + TRACE(("next_in_chain ")); + } else { + fprintf(stdout, "%d: (%u) invoking next_in_chain ", + iPtr->numLevels, (unsigned)(pc - codePtr->codeStart)); + } + for (i = 0; i < objc; i++) { + TclPrintObject(stdout, objv[i], 15); + fprintf(stdout, " "); + } + fprintf(stdout, "\n"); + fflush(stdout); + } +#endif /*TCL_COMPILE_DEBUG*/ + + bcFramePtr->data.tebc.pc = (char *) pc; + iPtr->cmdFramePtr = bcFramePtr; + + if (iPtr->flags & INTERP_DEBUG_FRAME) { + ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); + } + + pcAdjustment = 2; + cleanup = opnd; + DECACHE_STACK_INFO(); + iPtr->varFramePtr = framePtr->callerVarPtr; + pc += pcAdjustment; + TEBC_YIELD(); + oPtr = contextPtr->oPtr; + if (oPtr->flags & FILTER_HANDLING) { + TclNRAddCallback(interp, FinalizeOONextFilter, + framePtr, contextPtr, INT2PTR(contextPtr->index), + INT2PTR(contextPtr->skip)); + } else { + TclNRAddCallback(interp, FinalizeOONext, + framePtr, contextPtr, INT2PTR(contextPtr->index), + INT2PTR(contextPtr->skip)); + } + if (contextPtr->callPtr->chain[++contextPtr->index].isFilter + || contextPtr->callPtr->flags & FILTER_HANDLING) { + oPtr->flags |= FILTER_HANDLING; + } else { + oPtr->flags &= ~FILTER_HANDLING; + } + contextPtr->skip = 1; + { + register Method *const mPtr = + contextPtr->callPtr->chain[contextPtr->index].mPtr; + + return mPtr->typePtr->callProc(mPtr->clientData, interp, + (Tcl_ObjectContext) contextPtr, opnd, + &OBJ_AT_DEPTH(opnd-1)); + } case INST_TCLOO_IS_OBJECT: oPtr = (Object *) Tcl_GetObjectFromObj(interp, OBJ_AT_TOS); @@ -4455,6 +4698,7 @@ TEBCresume( } /* + * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ @@ -4476,19 +4720,19 @@ TEBCresume( NEXT_INST_V(5, opnd, 1); case INST_LIST_LENGTH: - valuePtr = OBJ_AT_TOS; - if (TclListObjLength(interp, valuePtr, &length) != TCL_OK) { - TRACE_WITH_OBJ(("%.30s => ERROR: ", O2S(valuePtr)), - Tcl_GetObjResult(interp)); + TRACE(("\"%.30s\" => ", O2S(OBJ_AT_TOS))); + if (TclListObjLength(interp, OBJ_AT_TOS, &length) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } TclNewIntObj(objResultPtr, length); - TRACE(("%.20s => %d\n", O2S(valuePtr), length)); + TRACE_APPEND(("%d\n", length)); NEXT_INST_F(1, 1, 1); case INST_LIST_INDEX: /* lindex with objc == 3 */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Extract the desired list element. @@ -4506,8 +4750,7 @@ TEBCresume( objResultPtr = TclLindexList(interp, valuePtr, value2Ptr); if (!objResultPtr) { - TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", O2S(valuePtr), - O2S(value2Ptr)), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4515,8 +4758,7 @@ TEBCresume( * Stash the list element on the stack. */ - TRACE(("%.20s %.20s => %s\n", - O2S(valuePtr), O2S(value2Ptr), O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, -1); /* Already has the correct refCount */ case INST_LIST_INDEX_IMM: /* lindex with objc==3 and index in bytecode @@ -4528,6 +4770,7 @@ TEBCresume( valuePtr = OBJ_AT_TOS; opnd = TclGetInt4AtPtr(pc+1); + TRACE(("\%.30s\" %d => ", O2S(valuePtr), opnd)); /* * Get the contents of the list, making sure that it really is a list @@ -4535,8 +4778,7 @@ TEBCresume( */ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { - TRACE_WITH_OBJ(("\"%.30s\" %d => ERROR: ", O2S(valuePtr), opnd), - Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4559,8 +4801,7 @@ TEBCresume( TclNewObj(objResultPtr); } - TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd), - objResultPtr); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(pcAdjustment, 1, 1); case INST_LIST_INDEX_MULTI: /* 'lindex' with multiple index args */ @@ -4575,10 +4816,11 @@ TEBCresume( * Do the 'lindex' operation. */ + TRACE(("%d => ", opnd)); objResultPtr = TclLindexFlat(interp, OBJ_AT_DEPTH(numIndices), numIndices, &OBJ_AT_DEPTH(numIndices - 1)); if (!objResultPtr) { - TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4586,7 +4828,7 @@ TEBCresume( * Set result. */ - TRACE(("%d => %s\n", opnd, O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(5, opnd, -1); case INST_LSET_FLAT: @@ -4596,6 +4838,7 @@ TEBCresume( opnd = TclGetUInt4AtPtr(pc + 1); numIndices = opnd - 2; + TRACE(("%d => ", opnd)); /* * Get the old value of variable, and remove the stack ref. This is @@ -4614,7 +4857,7 @@ TEBCresume( objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); if (!objResultPtr) { - TRACE_WITH_OBJ(("%d => ERROR: ", opnd), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4622,7 +4865,7 @@ TEBCresume( * Set result. */ - TRACE(("%d => %s\n", opnd, O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(5, numIndices+1, -1); case INST_LSET_LIST: /* 'lset' with 4 args */ @@ -4642,6 +4885,8 @@ TEBCresume( valuePtr = OBJ_AT_TOS; value2Ptr = OBJ_UNDER_TOS; + TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", + O2S(value2Ptr), O2S(valuePtr), O2S(objPtr))); /* * Compute the new variable value. @@ -4649,8 +4894,7 @@ TEBCresume( objResultPtr = TclLsetList(interp, objPtr, value2Ptr, valuePtr); if (!objResultPtr) { - TRACE_WITH_OBJ(("\"%.30s\" => ERROR: ", O2S(value2Ptr)), - Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4658,7 +4902,7 @@ TEBCresume( * Set result. */ - TRACE(("=> %s\n", O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, -1); case INST_LIST_RANGE_IMM: /* lrange with objc==4 and both indices in @@ -4671,6 +4915,8 @@ TEBCresume( valuePtr = OBJ_AT_TOS; fromIdx = TclGetInt4AtPtr(pc+1); toIdx = TclGetInt4AtPtr(pc+5); + TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), TclGetInt4AtPtr(pc+1), + TclGetInt4AtPtr(pc+5))); /* * Get the contents of the list, making sure that it really is a list @@ -4678,8 +4924,7 @@ TEBCresume( */ if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) { - TRACE_WITH_OBJ(("\"%.30s\" %d %d => ERROR: ", O2S(valuePtr), - fromIdx, toIdx), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } @@ -4736,8 +4981,6 @@ TEBCresume( List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1; if (listPtr->refCount == 1) { - TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr), - TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5))); for (index=toIdx+1; index<objc ; index++) { TclDecrRefCount(objv[index]); } @@ -4753,8 +4996,7 @@ TEBCresume( TclNewObj(objResultPtr); } - TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr), - TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)), objResultPtr); + TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); case INST_LIST_IN: @@ -4763,9 +5005,9 @@ TEBCresume( valuePtr = OBJ_UNDER_TOS; s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ERROR: ", O2S(valuePtr), - O2S(value2Ptr)), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } match = 0; @@ -4796,7 +5038,7 @@ TEBCresume( match = !match; } - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); + TRACE_APPEND(("%d\n", match)); /* * Peep-hole optimisation: if you're about to jump, do jump from here. @@ -4804,21 +5046,7 @@ TEBCresume( * for branching. */ - pc++; -#ifndef TCL_COMPILE_DEBUG - switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match ? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match ? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: - NEXT_INST_F((match ? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: - NEXT_INST_F((match ? TclGetInt4AtPtr(pc+1) : 5), 2, 0); - } -#endif - objResultPtr = TCONST(match); - NEXT_INST_F(0, 2, 1); + JUMP_PEEPHOLE_F(match, 1, 2); case INST_LIST_CONCAT: value2Ptr = OBJ_AT_TOS; @@ -4828,7 +5056,7 @@ TEBCresume( objResultPtr = Tcl_DuplicateObj(valuePtr); if (Tcl_ListObjAppendList(interp, objResultPtr, value2Ptr) != TCL_OK) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); TclDecrRefCount(objResultPtr); goto gotError; } @@ -4836,7 +5064,7 @@ TEBCresume( NEXT_INST_F(1, 2, 1); } else { if (Tcl_ListObjAppendList(interp, valuePtr, value2Ptr) != TCL_OK){ - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); @@ -4971,25 +5199,71 @@ TEBCresume( break; } } - if (match < 0) { - TclNewIntObj(objResultPtr, -1); - } else { - objResultPtr = TCONST(match > 0); - } - TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), - O2S(objResultPtr))); - NEXT_INST_F(1, 2, 1); + + TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), + (match < 0 ? -1 : match > 0 ? 1 : 0))); + JUMP_PEEPHOLE_F(match, 1, 2); case INST_STR_LEN: valuePtr = OBJ_AT_TOS; length = Tcl_GetCharLength(valuePtr); TclNewIntObj(objResultPtr, length); - TRACE(("%.20s => %d\n", O2S(valuePtr), length)); + TRACE(("\"%.20s\" => %d\n", O2S(valuePtr), length)); NEXT_INST_F(1, 1, 1); + case INST_STR_UPPER: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToUpper(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToUpper(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_LOWER: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToLower(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToLower(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_TITLE: + valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); + if (Tcl_IsShared(valuePtr)) { + s1 = TclGetStringFromObj(valuePtr, &length); + TclNewStringObj(objResultPtr, s1, length); + length = Tcl_UtfToTitle(TclGetString(objResultPtr)); + Tcl_SetObjLength(objResultPtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + length = Tcl_UtfToTitle(TclGetString(valuePtr)); + Tcl_SetObjLength(valuePtr, length); + TRACE_APPEND(("\"%.20s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + case INST_STR_INDEX: value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; + TRACE(("\"%.20s\" %.20s => ", O2S(valuePtr), O2S(value2Ptr))); /* * Get char length to calulate what 'end' means. @@ -4997,6 +5271,7 @@ TEBCresume( length = Tcl_GetCharLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { + TRACE_ERROR(interp); goto gotError; } @@ -5022,18 +5297,18 @@ TEBCresume( objResultPtr = Tcl_NewStringObj(buf, length); } - TRACE(("%.20s %.20s => %s\n", O2S(valuePtr), O2S(value2Ptr), - O2S(objResultPtr))); + TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_STR_RANGE: - TRACE(("\"%.20s\" %s %s =>", + TRACE(("\"%.20s\" %.20s %.20s =>", O2S(OBJ_AT_DEPTH(2)), O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS))); length = Tcl_GetCharLength(OBJ_AT_DEPTH(2)) - 1; if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, &fromIdx) != TCL_OK || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, &toIdx) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } @@ -5093,33 +5368,206 @@ TEBCresume( int length3; Tcl_Obj *value3Ptr; + case INST_STR_REPLACE: + value3Ptr = POP_OBJECT(); + valuePtr = OBJ_AT_DEPTH(2); + length = Tcl_GetCharLength(valuePtr) - 1; + TRACE(("\"%.20s\" %s %s \"%.20s\" => ", O2S(valuePtr), + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(value3Ptr))); + if (TclGetIntForIndexM(interp, OBJ_UNDER_TOS, length, + &fromIdx) != TCL_OK + || TclGetIntForIndexM(interp, OBJ_AT_TOS, length, + &toIdx) != TCL_OK) { + TclDecrRefCount(value3Ptr); + TRACE_ERROR(interp); + goto gotError; + } + TclDecrRefCount(OBJ_AT_TOS); + (void) POP_OBJECT(); + TclDecrRefCount(OBJ_AT_TOS); + (void) POP_OBJECT(); + if (fromIdx < 0) { + fromIdx = 0; + } + + if (fromIdx > toIdx || fromIdx > length) { + TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); + TclDecrRefCount(value3Ptr); + NEXT_INST_F(1, 0, 0); + } + + if (toIdx > length) { + toIdx = length; + } + + if (fromIdx == 0 && toIdx == length) { + TclDecrRefCount(OBJ_AT_TOS); + OBJ_AT_TOS = value3Ptr; + TRACE_APPEND(("\"%.30s\"\n", O2S(value3Ptr))); + NEXT_INST_F(1, 0, 0); + } + + length3 = Tcl_GetCharLength(value3Ptr); + + /* + * Remove substring. In-place. + */ + + if (length3 == 0 && !Tcl_IsShared(valuePtr) && toIdx == length) { + TclDecrRefCount(value3Ptr); + Tcl_SetObjLength(valuePtr, fromIdx); + TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + + /* + * See if we can splice in place. This happens when the number of + * characters being replaced is the same as the number of characters + * in the string to be inserted. + */ + + if (length3 - 1 == toIdx - fromIdx) { + unsigned char *bytes1, *bytes2; + + if (Tcl_IsShared(valuePtr)) { + objResultPtr = Tcl_DuplicateObj(valuePtr); + if (TclIsPureByteArray(objResultPtr) + && TclIsPureByteArray(value3Ptr)) { + bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL); + bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL); + memcpy(bytes1 + fromIdx, bytes2, length3); + } else { + ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL); + ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); + memcpy(ustring1 + fromIdx, ustring2, + length3 * sizeof(Tcl_UniChar)); + + /* + * Magic! Flush the info in the string internal rep that + * refers to the about-to-be-invalidated UTF-8 rep. This + * sets the 'allocated' field of the String structure to 0 + * to indicate that a new buffer needs to be allocated. + * This is safe; we know we've got a tclStringTypePtr set + * at this point (post Tcl_GetUnicodeFromObj). + */ + + ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + } + Tcl_InvalidateStringRep(objResultPtr); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } else { + if (TclIsPureByteArray(valuePtr) + && TclIsPureByteArray(value3Ptr)) { + bytes1 = Tcl_GetByteArrayFromObj(valuePtr, NULL); + bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL); + memcpy(bytes1 + fromIdx, bytes2, length3); + } else { + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, NULL); + ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL); + memcpy(ustring1 + fromIdx, ustring2, + length3 * sizeof(Tcl_UniChar)); + + /* + * Magic! Flush the info in the string internal rep that + * refers to the about-to-be-invalidated UTF-8 rep. This + * sets the 'allocated' field of the String structure to 0 + * to indicate that a new buffer needs to be allocated. + * This is safe; we know we've got a tclStringTypePtr set + * at this point (post Tcl_GetUnicodeFromObj). + */ + + ((int *) objResultPtr->internalRep.otherValuePtr)[1] = 0; + } + Tcl_InvalidateStringRep(valuePtr); + TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr))); + NEXT_INST_F(1, 0, 0); + } + } + + /* + * Get the unicode representation; this is where we guarantee to lose + * bytearrays. + */ + + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + length--; + + /* + * Remove substring using copying. + */ + + if (length3 == 0) { + if (fromIdx > 0) { + objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else { + objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1, + length - toIdx); + } + TclDecrRefCount(value3Ptr); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + } + + /* + * Splice string pieces by full copying. + */ + + if (fromIdx > 0) { + objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx); + Tcl_AppendObjToObj(objResultPtr, value3Ptr); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else if (Tcl_IsShared(value3Ptr)) { + objResultPtr = Tcl_DuplicateObj(value3Ptr); + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } else { + objResultPtr = value3Ptr; + if (toIdx < length) { + Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1, + length - toIdx); + } + } + TclDecrRefCount(value3Ptr); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); + NEXT_INST_F(1, 1, 1); + case INST_STR_MAP: valuePtr = OBJ_AT_TOS; /* "Main" string. */ value3Ptr = OBJ_UNDER_TOS; /* "Target" string. */ value2Ptr = OBJ_AT_DEPTH(2); /* "Source" string. */ if (value3Ptr == value2Ptr) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (valuePtr == value2Ptr) { objResultPtr = value3Ptr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); if (length == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring2 = Tcl_GetUnicodeFromObj(value2Ptr, &length2); if (length2 > length || length2 == 0) { objResultPtr = valuePtr; - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } else if (length2 == length) { if (memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length)) { objResultPtr = valuePtr; } else { objResultPtr = value3Ptr; } - NEXT_INST_V(1, 3, 1); + goto doneStringMap; } ustring3 = Tcl_GetUnicodeFromObj(value3Ptr, &length3); @@ -5148,6 +5596,7 @@ TEBCresume( Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1 - p); } + doneStringMap: TRACE_WITH_OBJ(("%.20s %.20s %.20s => ", O2S(value2Ptr), O2S(value3Ptr), O2S(valuePtr)), objResultPtr); NEXT_INST_V(1, 3, 1); @@ -5170,7 +5619,6 @@ TEBCresume( TRACE(("%.20s %.20s => %d\n", O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match)); - TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); @@ -5236,26 +5684,57 @@ TEBCresume( * Peep-hole optimisation: if you're about to jump, do jump from here. */ - pc += 2; -#ifndef TCL_COMPILE_DEBUG - switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: - NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: - NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); + JUMP_PEEPHOLE_F(match, 2, 2); + + { + const char *string1, *string2; + int trim1, trim2; + + case INST_STR_TRIM_LEFT: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim1 = TclTrimLeft(string1, length, string2, length2); + trim2 = 0; + goto createTrimmedString; + case INST_STR_TRIM_RIGHT: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim2 = TclTrimRight(string1, length, string2, length2); + trim1 = 0; + goto createTrimmedString; + case INST_STR_TRIM: + valuePtr = OBJ_UNDER_TOS; /* String */ + value2Ptr = OBJ_AT_TOS; /* TrimSet */ + string2 = TclGetStringFromObj(value2Ptr, &length2); + string1 = TclGetStringFromObj(valuePtr, &length); + trim1 = TclTrimLeft(string1, length, string2, length2); + if (trim1 < length) { + trim2 = TclTrimRight(string1, length, string2, length2); + } else { + trim2 = 0; } -#endif - objResultPtr = TCONST(match); - NEXT_INST_F(0, 2, 1); + createTrimmedString: + if (trim1 == 0 && trim2 == 0) { + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), valuePtr); + NEXT_INST_F(1, 1, 0); + } else { + objResultPtr = Tcl_NewStringObj(string1+trim1, length-trim1-trim2); + TRACE_WITH_OBJ(("\"%.30s\" \"%.30s\" => ", + O2S(valuePtr), O2S(value2Ptr)), objResultPtr); + NEXT_INST_F(1, 2, 1); + } + } case INST_REGEXP: cflags = TclGetInt1AtPtr(pc+1); /* RE compile flages like NOCASE */ valuePtr = OBJ_AT_TOS; /* String */ value2Ptr = OBJ_UNDER_TOS; /* Pattern */ + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* * Compile and match the regular expression. @@ -5266,44 +5745,24 @@ TEBCresume( Tcl_GetRegExpFromObj(interp, value2Ptr, cflags); if (regExpr == NULL) { - goto regexpFailure; + TRACE_ERROR(interp); + goto gotError; } - match = Tcl_RegExpExecObj(interp, regExpr, valuePtr, 0, 0, 0); - if (match < 0) { - regexpFailure: -#ifdef TCL_COMPILE_DEBUG - objResultPtr = Tcl_GetObjResult(interp); - TRACE_WITH_OBJ(("%.20s %.20s => ERROR: ", - O2S(valuePtr), O2S(value2Ptr)), objResultPtr); -#endif + TRACE_ERROR(interp); goto gotError; } } - TRACE(("%.20s %.20s => %d\n", O2S(valuePtr), O2S(value2Ptr), match)); + TRACE_APPEND(("%d\n", match)); /* * Peep-hole optimisation: if you're about to jump, do jump from here. * Adjustment is 2 due to the nocase byte. */ - pc += 2; -#ifndef TCL_COMPILE_DEBUG - switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((match? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((match? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: - NEXT_INST_F((match? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: - NEXT_INST_F((match? TclGetInt4AtPtr(pc+1) : 5), 2, 0); - } -#endif - objResultPtr = TCONST(match); - NEXT_INST_F(0, 2, 1); + JUMP_PEEPHOLE_F(match, 2, 2); } /* @@ -5401,21 +5860,9 @@ TEBCresume( */ foundResult: - pc++; -#ifndef TCL_COMPILE_DEBUG - switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((iResult? 2 : TclGetInt1AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((iResult? TclGetInt1AtPtr(pc+1) : 2), 2, 0); - case INST_JUMP_FALSE4: - NEXT_INST_F((iResult? 5 : TclGetInt4AtPtr(pc+1)), 2, 0); - case INST_JUMP_TRUE4: - NEXT_INST_F((iResult? TclGetInt4AtPtr(pc+1) : 5), 2, 0); - } -#endif - objResultPtr = TCONST(iResult); - NEXT_INST_F(0, 2, 1); + TRACE(("\"%.20s\" \"%.20s\" => %d\n", O2S(valuePtr), O2S(value2Ptr), + iResult)); + JUMP_PEEPHOLE_F(iResult, 1, 2); } case INST_MOD: @@ -5502,13 +5949,13 @@ TEBCresume( if (l2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); -#if 0 +#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); CACHE_STACK_INFO(); -#endif +#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else if (l1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -5550,13 +5997,13 @@ TEBCresume( if (l2 < 0) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "negative shift argument", -1)); -#if 0 +#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", NULL); CACHE_STACK_INFO(); -#endif +#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else if (l1 == 0) { TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr))); @@ -5573,12 +6020,12 @@ TEBCresume( Tcl_SetObjResult(interp, Tcl_NewStringObj( "integer value too large to represent", -1)); -#if 0 +#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", "integer value too large to represent", NULL); CACHE_STACK_INFO(); -#endif +#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */ goto gotError; } else { int shift = (int) l2; @@ -5636,8 +6083,7 @@ TEBCresume( TRACE_APPEND(("DIVIDE BY ZERO\n")); goto divideByZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { - TRACE_APPEND(("ERROR: %s\n", - TclGetString(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); @@ -5809,8 +6255,7 @@ TEBCresume( TRACE_APPEND(("EXPONENT OF ZERO\n")); goto exponOfZero; } else if (objResultPtr == GENERAL_ARITHMETIC_ERROR) { - TRACE_APPEND(("ERROR: %s\n", - TclGetString(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } else if (objResultPtr == NULL) { TRACE_APPEND(("%s\n", O2S(valuePtr))); @@ -5828,7 +6273,7 @@ TEBCresume( /* TODO - check claim that taking address of b harms performance */ /* TODO - consider optimization search for constants */ if (TclGetBooleanFromObj(NULL, valuePtr, &b) != TCL_OK) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s\n", O2S(valuePtr), + TRACE(("\"%.20s\" => ERROR: illegal type %s\n", O2S(valuePtr), (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); @@ -5837,18 +6282,20 @@ TEBCresume( } /* TODO: Consider peephole opt. */ objResultPtr = TCONST(!b); + TRACE_WITH_OBJ(("%s => ", O2S(valuePtr)), objResultPtr); NEXT_INST_F(1, 1, 1); } case INST_BITNOT: valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || (type1==TCL_NUMBER_NAN) || (type1==TCL_NUMBER_DOUBLE)) { /* * ... ~$NonInteger => raise an error. */ - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), + TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); @@ -5859,23 +6306,28 @@ TEBCresume( l1 = *((const long *) ptr1); if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, ~l1); + TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } TclSetLongObj(valuePtr, ~l1); + TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr); if (objResultPtr != NULL) { + TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { + TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } case INST_UMINUS: valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); if ((GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) || IsErroringNaNType(type1)) { - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), + TRACE_APPEND(("ERROR: illegal type %s \n", (valuePtr->typePtr? valuePtr->typePtr->name : "null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); @@ -5885,23 +6337,28 @@ TEBCresume( switch (type1) { case TCL_NUMBER_NAN: /* -NaN => NaN */ + TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); case TCL_NUMBER_LONG: l1 = *((const long *) ptr1); if (l1 != LONG_MIN) { if (Tcl_IsShared(valuePtr)) { TclNewLongObj(objResultPtr, -l1); + TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } TclSetLongObj(valuePtr, -l1); + TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } /* FALLTHROUGH */ } objResultPtr = ExecuteExtendedUnaryMathOp(*pc, valuePtr); if (objResultPtr != NULL) { + TRACE_APPEND(("%s\n", O2S(objResultPtr))); NEXT_INST_F(1, 1, 1); } else { + TRACE_APPEND(("%s\n", O2S(valuePtr))); NEXT_INST_F(1, 0, 0); } @@ -5914,6 +6371,7 @@ TEBCresume( */ valuePtr = OBJ_AT_TOS; + TRACE(("\"%.20s\" => ", O2S(valuePtr))); if (GetNumberFromObj(NULL, valuePtr, &ptr1, &type1) != TCL_OK) { if (*pc == INST_UPLUS) { @@ -5921,7 +6379,7 @@ TEBCresume( * ... +$NonNumeric => raise an error. */ - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), + TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); @@ -5930,7 +6388,7 @@ TEBCresume( } /* ... TryConvertToNumeric($NonNumeric) is acceptable */ - TRACE(("\"%.20s\" => not numeric\n", O2S(valuePtr))); + TRACE_APPEND(("not numeric\n")); NEXT_INST_F(1, 0, 0); } if (IsErroringNaNType(type1)) { @@ -5939,7 +6397,7 @@ TEBCresume( * ... +$NonNumeric => raise an error. */ - TRACE(("\"%.20s\" => ILLEGAL TYPE %s \n", O2S(valuePtr), + TRACE_APPEND(("ERROR: illegal type %s\n", (valuePtr->typePtr? valuePtr->typePtr->name:"null"))); DECACHE_STACK_INFO(); IllegalExprOperandType(interp, pc, valuePtr); @@ -5949,8 +6407,7 @@ TEBCresume( * Numeric conversion of NaN -> error. */ - TRACE(("\"%.20s\" => IEEE FLOATING PT ERROR\n", - O2S(objResultPtr))); + TRACE_APPEND(("ERROR: IEEE floating pt error\n")); DECACHE_STACK_INFO(); TclExprFloatError(interp, *((const double *) ptr1)); CACHE_STACK_INFO(); @@ -5968,7 +6425,7 @@ TEBCresume( */ if (valuePtr->bytes == NULL) { - TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr))); + TRACE_APPEND(("numeric, same Tcl_Obj\n")); NEXT_INST_F(1, 0, 0); } if (Tcl_IsShared(valuePtr)) { @@ -5983,11 +6440,11 @@ TEBCresume( valuePtr->bytes = NULL; objResultPtr = Tcl_DuplicateObj(valuePtr); valuePtr->bytes = savedString; - TRACE(("\"%.20s\" => numeric, new Tcl_Obj\n", O2S(valuePtr))); + TRACE_APPEND(("numeric, new Tcl_Obj\n")); NEXT_INST_F(1, 1, 1); } TclInvalidateStringRep(valuePtr); - TRACE(("\"%.20s\" => numeric, same Tcl_Obj\n", O2S(valuePtr))); + TRACE_APPEND(("numeric, same Tcl_Obj\n")); NEXT_INST_F(1, 0, 0); } @@ -6004,6 +6461,7 @@ TEBCresume( */ result = TCL_BREAK; cleanup = 0; + TRACE(("=> BREAK!\n")); goto processExceptionReturn; case INST_CONTINUE: @@ -6014,6 +6472,7 @@ TEBCresume( */ result = TCL_CONTINUE; cleanup = 0; + TRACE(("=> CONTINUE!\n")); goto processExceptionReturn; { @@ -6025,7 +6484,7 @@ TEBCresume( int varIndex, valIndex, continueLoop, j, iterTmpIndex; long i; - case INST_FOREACH_START4: + case INST_FOREACH_START4: /* DEPRECATED */ /* * Initialize the temporary local var that holds the count of the * number of iterations of the loop body to -1. @@ -6058,13 +6517,14 @@ TEBCresume( NEXT_INST_F(5, 0, 0); #endif - case INST_FOREACH_STEP4: + case INST_FOREACH_STEP4: /* DEPRECATED */ /* * "Step" a foreach loop (i.e., begin its next iteration) by assigning * the next value list element to each loop var. */ opnd = TclGetUInt4AtPtr(pc+1); + TRACE(("%u => ", opnd)); infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; numLists = infoPtr->numLists; @@ -6091,8 +6551,8 @@ TEBCresume( listVarPtr = LOCAL(listTmpIndex); listPtr = listVarPtr->value.objPtr; if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { - TRACE_WITH_OBJ(("%u => ERROR converting list %ld, \"%s\": ", - opnd, i, O2S(listPtr)), Tcl_GetObjResult(interp)); + TRACE_APPEND(("ERROR converting list %ld, \"%.30s\": %s\n", + i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } if (listLen > iterNum * numVars) { @@ -6147,9 +6607,9 @@ TEBCresume( if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ CACHE_STACK_INFO(); - TRACE_WITH_OBJ(( - "%u => ERROR init. index temp %d: ", - opnd,varIndex), Tcl_GetObjResult(interp)); + TRACE_APPEND(( + "ERROR init. index temp %d: %s\n", + varIndex, O2S(Tcl_GetObjResult(interp)))); TclDecrRefCount(listPtr); goto gotError; } @@ -6161,8 +6621,8 @@ TEBCresume( listTmpIndex++; } } - TRACE(("%u => %d lists, iter %d, %s loop\n", opnd, numLists, - iterNum, (continueLoop? "continue" : "exit"))); + TRACE_APPEND(("%d lists, iter %d, %s loop\n", + numLists, iterNum, (continueLoop? "continue" : "exit"))); /* * Run-time peep-hole optimisation: the compiler ALWAYS follows @@ -6176,6 +6636,200 @@ TEBCresume( } else { NEXT_INST_F((continueLoop? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); } + + } + { + ForeachInfo *infoPtr; + Tcl_Obj *listPtr, **elements, *tmpPtr; + ForeachVarList *varListPtr; + int numLists, iterMax, listLen, numVars; + int iterTmp, iterNum, listTmpDepth; + int varIndex, valIndex, j; + long i; + + case INST_FOREACH_START: + /* + * Initialize the data for the looping construct, pushing the + * corresponding Tcl_Objs to the stack. + */ + + opnd = TclGetUInt4AtPtr(pc+1); + infoPtr = codePtr->auxDataArrayPtr[opnd].clientData; + numLists = infoPtr->numLists; + TRACE(("%u => ", opnd)); + + /* + * Compute the number of iterations that will be run: iterMax + */ + + iterMax = 0; + listTmpDepth = numLists-1; + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + listPtr = OBJ_AT_DEPTH(listTmpDepth); + if (TclListObjLength(interp, listPtr, &listLen) != TCL_OK) { + TRACE_APPEND(("ERROR converting list %ld, \"%s\": %s", + i, O2S(listPtr), O2S(Tcl_GetObjResult(interp)))); + goto gotError; + } + if (Tcl_IsShared(listPtr)) { + objPtr = TclListObjCopy(NULL, listPtr); + Tcl_IncrRefCount(objPtr); + Tcl_DecrRefCount(listPtr); + OBJ_AT_DEPTH(listTmpDepth) = objPtr; + } + iterTmp = (listLen + (numVars - 1))/numVars; + if (iterTmp > iterMax) { + iterMax = iterTmp; + } + listTmpDepth--; + } + + /* + * Store the iterNum and iterMax in a single Tcl_Obj; we keep a + * nul-string obj with the pointer stored in the ptrValue so that the + * thing is properly garbage collected. THIS OBJ MAKES NO SENSE, but + * it will never leave this scope and is read-only. + */ + + TclNewObj(tmpPtr); + tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0); + tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax); + PUSH_OBJECT(tmpPtr); /* iterCounts object */ + + /* + * Store a pointer to the ForeachInfo struct; same dirty trick + * as above + */ + + TclNewObj(tmpPtr); + tmpPtr->internalRep.otherValuePtr = infoPtr; + PUSH_OBJECT(tmpPtr); /* infoPtr object */ + TRACE_APPEND(("jump to loop step\n")); + + /* + * Jump directly to the INST_FOREACH_STEP instruction; the C code just + * falls through. + */ + + pc += 5 - infoPtr->loopCtTemp; + + case INST_FOREACH_STEP: + /* + * "Step" a foreach loop (i.e., begin its next iteration) by assigning + * the next value list element to each loop var. + */ + + tmpPtr = OBJ_AT_TOS; + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + TRACE(("=> ")); + + tmpPtr = OBJ_AT_DEPTH(1); + iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1); + iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2); + + /* + * If some list still has a remaining list element iterate one more + * time. Assign to var the next element from its value list. + */ + + if (iterNum < iterMax) { + /* + * Set the variables and jump back to run the body + */ + + tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1); + + listTmpDepth = numLists + 1; + + for (i = 0; i < numLists; i++) { + varListPtr = infoPtr->varLists[i]; + numVars = varListPtr->numVars; + + listPtr = OBJ_AT_DEPTH(listTmpDepth); + TclListObjGetElements(interp, listPtr, &listLen, &elements); + + valIndex = (iterNum * numVars); + for (j = 0; j < numVars; j++) { + if (valIndex >= listLen) { + TclNewObj(valuePtr); + } else { + valuePtr = elements[valIndex]; + } + + varIndex = varListPtr->varIndexes[j]; + varPtr = LOCAL(varIndex); + while (TclIsVarLink(varPtr)) { + varPtr = varPtr->value.linkPtr; + } + if (TclIsVarDirectWritable(varPtr)) { + value2Ptr = varPtr->value.objPtr; + if (valuePtr != value2Ptr) { + if (value2Ptr != NULL) { + TclDecrRefCount(value2Ptr); + } + varPtr->value.objPtr = valuePtr; + Tcl_IncrRefCount(valuePtr); + } + } else { + DECACHE_STACK_INFO(); + if (TclPtrSetVar(interp, varPtr, NULL, NULL, NULL, + valuePtr, TCL_LEAVE_ERR_MSG, varIndex)==NULL){ + CACHE_STACK_INFO(); + TRACE_APPEND(("ERROR init. index temp %d: %.30s", + varIndex, O2S(Tcl_GetObjResult(interp)))); + goto gotError; + } + CACHE_STACK_INFO(); + } + valIndex++; + } + listTmpDepth--; + } + TRACE_APPEND(("jump to loop start\n")); + /* loopCtTemp being 'misused' for storing the jump size */ + NEXT_INST_F(infoPtr->loopCtTemp, 0, 0); + } + + TRACE_APPEND(("loop has no more iterations\n")); +#ifdef TCL_COMPILE_DEBUG + NEXT_INST_F(1, 0, 0); +#else + /* + * FALL THROUGH + */ + pc++; +#endif + + case INST_FOREACH_END: + /* THIS INSTRUCTION IS ONLY CALLED AS A BREAK TARGET */ + tmpPtr = OBJ_AT_TOS; + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + TRACE(("=> loop terminated\n")); + NEXT_INST_V(1, numLists+2, 0); + + case INST_LMAP_COLLECT: + /* + * This instruction is only issued by lmap. The stack is: + * - result + * - infoPtr + * - loop counters + * - valLists + * - collecting obj (unshared) + * The instruction lappends the result to the collecting obj. + */ + + tmpPtr = OBJ_AT_DEPTH(1); + infoPtr = tmpPtr->internalRep.otherValuePtr; + numLists = infoPtr->numLists; + TRACE_APPEND(("=> appending to list at depth %d\n", 3 + numLists)); + + objPtr = OBJ_AT_DEPTH(3 + numLists); + Tcl_ListObjAppendElement(NULL, objPtr, OBJ_AT_TOS); + NEXT_INST_F(1, 1, 0); } case INST_BEGIN_CATCH4: @@ -6237,7 +6891,8 @@ TEBCresume( if (code < TCL_ERROR || code > TCL_CONTINUE) { code = TCL_CONTINUE + 1; } - NEXT_INST_F(2*code -1, 1, 0); + TRACE(("\"%s\" => jump offset %d\n", O2S(OBJ_AT_TOS), 2*code-1)); + NEXT_INST_F(2*code-1, 1, 0); } /* @@ -6254,10 +6909,10 @@ TEBCresume( case INST_DICT_VERIFY: dictPtr = OBJ_AT_TOS; - TRACE(("=> ")); + TRACE(("\"%.30s\" => ", O2S(dictPtr))); if (Tcl_DictObjSize(interp, dictPtr, &done) != TCL_OK) { - TRACE_APPEND(("ERROR verifying dictionary nature of \"%s\": %s\n", - O2S(OBJ_AT_DEPTH(opnd)), O2S(Tcl_GetObjResult(interp)))); + TRACE_APPEND(("ERROR verifying dictionary nature of \"%.30s\": %s\n", + O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); goto gotError; } TRACE_APPEND(("OK\n")); @@ -6266,6 +6921,7 @@ TEBCresume( case INST_DICT_GET: case INST_DICT_EXISTS: { register Tcl_Interp *interp2 = interp; + register int found; opnd = TclGetUInt4AtPtr(pc+1); TRACE(("%u => ", opnd)); @@ -6278,10 +6934,11 @@ TEBCresume( &OBJ_AT_DEPTH(opnd-1), DICT_PATH_READ); if (dictPtr == NULL) { if (*pc == INST_DICT_EXISTS) { - goto dictNotExists; + found = 0; + goto afterDictExists; } TRACE_WITH_OBJ(( - "ERROR tracing dictionary path into \"%s\": ", + "ERROR tracing dictionary path into \"%.30s\": ", O2S(OBJ_AT_DEPTH(opnd))), Tcl_GetObjResult(interp)); goto gotError; @@ -6290,34 +6947,40 @@ TEBCresume( if (Tcl_DictObjGet(interp2, dictPtr, OBJ_AT_TOS, &objResultPtr) == TCL_OK) { if (*pc == INST_DICT_EXISTS) { - objResultPtr = TCONST(objResultPtr ? 1 : 0); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(5, opnd+1, 1); + found = (objResultPtr ? 1 : 0); + goto afterDictExists; } - if (objResultPtr) { - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(5, opnd+1, 1); + if (!objResultPtr) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "key \"%s\" not known in dictionary", + TclGetString(OBJ_AT_TOS))); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", + TclGetString(OBJ_AT_TOS), NULL); + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; } - DECACHE_STACK_INFO(); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "key \"%s\" not known in dictionary", - TclGetString(OBJ_AT_TOS))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT", - TclGetString(OBJ_AT_TOS), NULL); - CACHE_STACK_INFO(); - TRACE_WITH_OBJ(("%u => ERROR ", opnd), Tcl_GetObjResult(interp)); + TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + NEXT_INST_V(5, opnd+1, 1); + } else if (*pc != INST_DICT_EXISTS) { + TRACE_APPEND(("ERROR reading leaf dictionary key \"%.30s\": %s", + O2S(dictPtr), O2S(Tcl_GetObjResult(interp)))); + goto gotError; } else { - if (*pc == INST_DICT_EXISTS) { - dictNotExists: - objResultPtr = TCONST(0); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); - NEXT_INST_V(5, opnd+1, 1); - } - TRACE_WITH_OBJ(( - "%u => ERROR reading leaf dictionary key \"%s\": ", - opnd, O2S(dictPtr)), Tcl_GetObjResult(interp)); + found = 0; } - goto gotError; + afterDictExists: + TRACE_APPEND(("%d\n", found)); + + /* + * The INST_DICT_EXISTS instruction is usually followed by a + * conditional jump, so we can take advantage of this to do some + * peephole optimization (note that we're careful to not close out + * someone doing something else). + */ + + JUMP_PEEPHOLE_V(found, 5, opnd+1); } case INST_DICT_SET: @@ -6391,8 +7054,8 @@ TEBCresume( if (allocateDict) { TclDecrRefCount(dictPtr); } - TRACE_WITH_OBJ(("%u %u => ERROR updating dictionary: ", - opnd, opnd2), Tcl_GetObjResult(interp)); + TRACE_APPEND(("ERROR updating dictionary: %s\n", + O2S(Tcl_GetObjResult(interp)))); goto checkForCatch; } @@ -6414,8 +7077,7 @@ TEBCresume( CACHE_STACK_INFO(); TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } } @@ -6424,7 +7086,7 @@ TEBCresume( NEXT_INST_V(10, cleanup, 0); } #endif - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_V(9, cleanup, 1); case INST_DICT_APPEND: @@ -6457,6 +7119,7 @@ TEBCresume( if (allocateDict) { TclDecrRefCount(dictPtr); } + TRACE_ERROR(interp); goto gotError; } @@ -6505,6 +7168,7 @@ TEBCresume( if (allocateDict) { TclDecrRefCount(dictPtr); } + TRACE_ERROR(interp); goto gotError; } Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr); @@ -6514,6 +7178,7 @@ TEBCresume( if (allocateDict) { TclDecrRefCount(dictPtr); } + TRACE_ERROR(interp); goto gotError; } @@ -6550,8 +7215,7 @@ TEBCresume( CACHE_STACK_INFO(); TclDecrRefCount(dictPtr); if (objResultPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", - O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } } @@ -6571,6 +7235,7 @@ TEBCresume( if (Tcl_DictObjFirst(interp, dictPtr, searchPtr, &keyPtr, &valuePtr, &done) != TCL_OK) { ckfree(searchPtr); + TRACE_ERROR(interp); goto gotError; } TclNewObj(statePtr); @@ -6606,8 +7271,9 @@ TEBCresume( PUSH_OBJECT(valuePtr); PUSH_OBJECT(keyPtr); } + TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n", + O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); -#ifndef TCL_COMPILE_DEBUG /* * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always * followed by a conditional jump, so we can take advantage of this to @@ -6615,37 +7281,17 @@ TEBCresume( * out someone doing something else). */ - pc += 5; - switch (*pc) { - case INST_JUMP_FALSE1: - NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0); - case INST_JUMP_FALSE4: - NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0); - case INST_JUMP_TRUE1: - NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0); - case INST_JUMP_TRUE4: - NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0); - default: - pc -= 5; - /* fall through to non-debug handling */ - } -#endif - - TRACE_APPEND(("\"%.30s\" \"%.30s\" %d\n", - O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done)); - objResultPtr = TCONST(done); - /* TODO: consider opt like INST_FOREACH_STEP4 */ - NEXT_INST_F(5, 0, 1); + JUMP_PEEPHOLE_F(done, 5, 0); case INST_DICT_UPDATE_START: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); + TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - TRACE(("%u => \n", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { @@ -6654,11 +7300,13 @@ TEBCresume( TCL_LEAVE_ERR_MSG, opnd); CACHE_STACK_INFO(); if (dictPtr == NULL) { + TRACE_ERROR(interp); goto gotError; } } if (TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } if (length != duiPtr->length) { @@ -6667,6 +7315,7 @@ TEBCresume( for (i=0 ; i<length ; i++) { if (Tcl_DictObjGet(interp, dictPtr, keyPtrPtr[i], &valuePtr) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } varPtr = LOCAL(duiPtr->varIndices[i]); @@ -6682,21 +7331,23 @@ TEBCresume( valuePtr, TCL_LEAVE_ERR_MSG, duiPtr->varIndices[i]) == NULL) { CACHE_STACK_INFO(); + TRACE_ERROR(interp); goto gotError; } CACHE_STACK_INFO(); } + TRACE_APPEND(("OK\n")); NEXT_INST_F(9, 0, 0); case INST_DICT_UPDATE_END: opnd = TclGetUInt4AtPtr(pc+1); opnd2 = TclGetUInt4AtPtr(pc+5); + TRACE(("%u => ", opnd)); varPtr = LOCAL(opnd); duiPtr = codePtr->auxDataArrayPtr[opnd2].clientData; while (TclIsVarLink(varPtr)) { varPtr = varPtr->value.linkPtr; } - TRACE(("%u => ", opnd)); if (TclIsVarDirectReadable(varPtr)) { dictPtr = varPtr->value.objPtr; } else { @@ -6705,11 +7356,13 @@ TEBCresume( CACHE_STACK_INFO(); } if (dictPtr == NULL) { + TRACE_APPEND(("storage was unset\n")); NEXT_INST_F(9, 1, 0); } if (Tcl_DictObjSize(interp, dictPtr, &length) != TCL_OK || TclListObjGetElements(interp, OBJ_AT_TOS, &length, &keyPtrPtr) != TCL_OK) { + TRACE_ERROR(interp); goto gotError; } allocdict = Tcl_IsShared(dictPtr); @@ -6755,27 +7408,27 @@ TEBCresume( if (allocdict) { TclDecrRefCount(dictPtr); } + TRACE_ERROR(interp); goto gotError; } } + TRACE_APPEND(("written back\n")); NEXT_INST_F(9, 1, 0); case INST_DICT_EXPAND: dictPtr = OBJ_UNDER_TOS; listPtr = OBJ_AT_TOS; + TRACE(("\"%.30s\" \"%.30s\" =>", O2S(dictPtr), O2S(listPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { - TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", - O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } objResultPtr = TclDictWithInit(interp, dictPtr, objc, objv); if (objResultPtr == NULL) { - TRACE_WITH_OBJ(("%.30s %.30s => ERROR: ", - O2S(dictPtr), O2S(listPtr)), Tcl_GetObjResult(interp)); + TRACE_ERROR(interp); goto gotError; } - TRACE((" => ")); - TRACE_APPEND(("%.30s\n", O2S(objResultPtr))); + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(1, 2, 1); case INST_DICT_RECOMBINE_STK: @@ -6785,14 +7438,14 @@ TEBCresume( TRACE(("\"%.30s\" \"%.30s\" \"%.30s\" => ", O2S(varNamePtr), O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; } varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_LEAVE_ERR_MSG, "set", 1, 1, &arrayPtr); if (varPtr == NULL) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); TclDecrRefCount(keysPtr); goto gotError; } @@ -6802,7 +7455,7 @@ TEBCresume( CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); if (result != TCL_OK) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("OK\n")); @@ -6816,7 +7469,7 @@ TEBCresume( TRACE(("%u <- \"%.30s\" \"%.30s\" => ", opnd, O2S(valuePtr), O2S(keysPtr))); if (TclListObjGetElements(interp, listPtr, &objc, &objv) != TCL_OK) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } while (TclIsVarLink(varPtr)) { @@ -6827,7 +7480,7 @@ TEBCresume( objc, objv, keysPtr); CACHE_STACK_INFO(); if (result != TCL_OK) { - TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); + TRACE_ERROR(interp); goto gotError; } TRACE_APPEND(("OK\n")); @@ -6923,10 +7576,10 @@ TEBCresume( if (traceInstructions) { objPtr = Tcl_GetObjResult(interp); if ((result != TCL_ERROR) && (result != TCL_RETURN)) { - TRACE_APPEND(("OTHER RETURN CODE %d, result= \"%s\"\n ", + TRACE_APPEND(("OTHER RETURN CODE %d, result=\"%.30s\"\n ", result, O2S(objPtr))); } else { - TRACE_APPEND(("%s, result= \"%s\"\n", + TRACE_APPEND(("%s, result=\"%.30s\"\n", StringForResultCode(result), O2S(objPtr))); } } @@ -6939,8 +7592,8 @@ TEBCresume( */ divideByZero: - DECACHE_STACK_INFO(); Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1)); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL); CACHE_STACK_INFO(); goto gotError; @@ -6951,9 +7604,9 @@ TEBCresume( */ exponOfZero: - DECACHE_STACK_INFO(); Tcl_SetObjResult(interp, Tcl_NewStringObj( "exponentiation of zero by negative power", -1)); + DECACHE_STACK_INFO(); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "exponentiation of zero by negative power", NULL); CACHE_STACK_INFO(); @@ -7179,6 +7832,58 @@ TEBCresume( #undef auxObjList #undef catchTop #undef TCONST + +static int +FinalizeOONext( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + CallContext *contextPtr = data[1]; + + /* + * Reset the variable lookup frame. + */ + + iPtr->varFramePtr = data[0]; + + /* + * Restore the call chain context index as we've finished the inner invoke + * and want to operate in the outer context again. + */ + + contextPtr->index = PTR2INT(data[2]); + contextPtr->skip = PTR2INT(data[3]); + contextPtr->oPtr->flags &= ~FILTER_HANDLING; + return result; +} + +static int +FinalizeOONextFilter( + ClientData data[], + Tcl_Interp *interp, + int result) +{ + Interp *iPtr = (Interp *) interp; + CallContext *contextPtr = data[1]; + + /* + * Reset the variable lookup frame. + */ + + iPtr->varFramePtr = data[0]; + + /* + * Restore the call chain context index as we've finished the inner invoke + * and want to operate in the outer context again. + */ + + contextPtr->index = PTR2INT(data[2]); + contextPtr->skip = PTR2INT(data[3]); + contextPtr->oPtr->flags |= FILTER_HANDLING; + return result; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index bfe6a10..825f408 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -661,12 +661,13 @@ TransformInputProc( * had some data before we report that instead of the request to * re-try. */ + int error = Tcl_GetErrno(); - if ((Tcl_GetErrno() == EAGAIN) && (gotBytes > 0)) { + if ((error == EAGAIN) && (gotBytes > 0)) { return gotBytes; } - *errorCodePtr = Tcl_GetErrno(); + *errorCodePtr = error; return -1; } else if (read == 0) { /* diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 7d6c462..694501f 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -139,7 +139,7 @@ int TclCreateSocketAddress( Tcl_Interp *interp, /* Interpreter for querying * the desired socket family */ - void **addrlist, /* Socket address list */ + struct addrinfo **addrlist, /* Socket address list */ const char *host, /* Host. NULL implies INADDR_ANY */ int port, /* Port number */ int willBind, /* Is this an address to bind() to or @@ -213,7 +213,7 @@ TclCreateSocketAddress( hints.ai_flags |= AI_PASSIVE; } - result = getaddrinfo(native, portstring, &hints, (struct addrinfo **) addrlist); + result = getaddrinfo(native, portstring, &hints, addrlist); if (host != NULL) { Tcl_DStringFree(&ds); diff --git a/generic/tclInt.decls b/generic/tclInt.decls index f0e907f..9f7b106 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -1006,6 +1006,12 @@ declare 249 { declare 250 { void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force) } + +# Allow extensions for optimization +declare 251 { + int TclRegisterLiteral(void *envPtr, + char *bytes, int length, int flags) +} ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index 380284f..3aaa30b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1809,7 +1809,14 @@ typedef struct Interp { ClientData interpInfo; /* Information used by tclInterp.c to keep * track of master/slave interps on a * per-interp basis. */ - Tcl_HashTable unused2; /* No longer used (was mathFuncTable) */ + union { + void (*optimizer)(void *envPtr); + Tcl_HashTable unused2; /* No longer used (was mathFuncTable). The + * unused space in interp was repurposed for + * pluggable bytecode optimizers. The core + * contains one optimizer, which can be + * selectively overriden by extensions. */ + } extra; /* * Information related to procedures and variables. See tclProc.c and @@ -3001,8 +3008,9 @@ MODULE_SCOPE void TclpFinalizeMutex(Tcl_Mutex *mutexPtr); MODULE_SCOPE void TclpFinalizePipes(void); MODULE_SCOPE void TclpFinalizeSockets(void); MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, - void **addrlist, const char *host, int port, - int willBind, const char **errorMsgPtr); + struct addrinfo **addrlist, + const char *host, int port, int willBind, + const char **errorMsgPtr); MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, ClientData clientData, int stackSize, int flags); @@ -3434,6 +3442,9 @@ MODULE_SCOPE int TclCompileBreakCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileCatchCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileConcatCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileContinueCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3533,6 +3544,9 @@ MODULE_SCOPE int TclCompileLassignCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileLindexCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileLinsertCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileListCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3557,6 +3571,9 @@ MODULE_SCOPE int TclCompileNamespaceCodeCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileNamespaceCurrentCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileNamespaceOriginCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3572,6 +3589,9 @@ MODULE_SCOPE int TclCompileNamespaceWhichCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileObjectNextCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileObjectSelfCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3614,6 +3634,27 @@ MODULE_SCOPE int TclCompileStringMatchCmd(Tcl_Interp *interp, MODULE_SCOPE int TclCompileStringRangeCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringReplaceCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToLowerCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToTitleCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringToUpperCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimLCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); +MODULE_SCOPE int TclCompileStringTrimRCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + struct CompileEnv *envPtr); MODULE_SCOPE int TclCompileSubstCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); @@ -3857,6 +3898,8 @@ MODULE_SCOPE int TclPtrUnsetVar(Tcl_Interp *interp, Var *varPtr, Tcl_Obj *part2Ptr, const int flags, int index); MODULE_SCOPE void TclInvalidateNsPath(Namespace *nsPtr); +MODULE_SCOPE void TclFindArrayPtrElements(Var *arrayPtr, + Tcl_HashTable *tablePtr); /* * The new extended interface to the variable traces. diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 533d6f4..f95f999 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -52,6 +52,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -610,6 +614,9 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags, /* 250 */ EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force); +/* 251 */ +EXTERN int TclRegisterLiteral(void *envPtr, char *bytes, + int length, int flags); typedef struct TclIntStubs { int magic; @@ -866,12 +873,11 @@ typedef struct TclIntStubs { int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */ char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */ void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */ + int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */ } TclIntStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclIntStubs *tclIntStubsPtr; + #ifdef __cplusplus } #endif @@ -1297,6 +1303,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclDoubleDigits) /* 249 */ #define TclSetSlaveCancelFlags \ (tclIntStubsPtr->tclSetSlaveCancelFlags) /* 250 */ +#define TclRegisterLiteral \ + (tclIntStubsPtr->tclRegisterLiteral) /* 251 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 3181d4e..72719fe 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -37,6 +37,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -355,10 +359,8 @@ typedef struct TclIntPlatStubs { #endif /* MACOSX */ } TclIntPlatStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclIntPlatStubs *tclIntPlatStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 11da6f8..2b0cc7e 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -358,7 +358,7 @@ TclFetchLiteral( int TclRegisterLiteral( - CompileEnv *envPtr, /* Points to the CompileEnv in whose object + void *ePtr, /* Points to the CompileEnv in whose object * array an object is found or created. */ register char *bytes, /* Points to string for which to find or * create an object in CompileEnv's object @@ -372,6 +372,7 @@ TclRegisterLiteral( * the literal should not be shared accross * namespaces. */ { + CompileEnv *envPtr = ePtr; Interp *iPtr = envPtr->iPtr; LiteralTable *localTablePtr = &envPtr->localLitTable; LiteralEntry *globalPtr, *localPtr; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index bdd5386..8f2f10e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -171,7 +171,7 @@ static const EnsembleImplMap defaultNamespaceMap[] = { {"forget", NamespaceForgetCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"import", NamespaceImportCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, {"inscope", NamespaceInscopeCmd, NULL, NRNamespaceInscopeCmd, NULL, 0}, - {"origin", NamespaceOriginCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"origin", NamespaceOriginCmd, TclCompileNamespaceOriginCmd, NULL, NULL, 0}, {"parent", NamespaceParentCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"path", NamespacePathCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0}, @@ -673,6 +673,10 @@ Tcl_CreateNamespace( Tcl_DString *namePtr, *buffPtr; int newEntry, nameLen; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + const char *nameStr; + Tcl_DString tmpBuffer; + + Tcl_DStringInit(&tmpBuffer); /* * If there is no active namespace, the interpreter is being initialized. @@ -686,49 +690,78 @@ Tcl_CreateNamespace( parentPtr = NULL; simpleName = ""; - } else if (*name == '\0') { + goto doCreate; + } + + /* + * Ensure that there are no trailing colons as that causes chaos when a + * deleteProc is specified. [Bug d614d63989] + */ + + if (deleteProc != NULL) { + nameStr = name + strlen(name) - 2; + if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') { + Tcl_DStringAppend(&tmpBuffer, name, -1); + while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0 + && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') { + Tcl_DStringSetLength(&tmpBuffer, nameLen-1); + } + name = Tcl_DStringValue(&tmpBuffer); + } + } + + /* + * If we've ended up with an empty string now, we're attempting to create + * the global namespace despite the global namespace existing. That's + * naughty! + */ + + if (*name == '\0') { Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace" " \"\": only global namespace can have empty name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", "CREATEGLOBAL", NULL); + Tcl_DStringFree(&tmpBuffer); return NULL; - } else { - /* - * Find the parent for the new namespace. - */ + } + + /* + * Find the parent for the new namespace. + */ - TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN, - &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); + TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN, + &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName); - /* - * If the unqualified name at the end is empty, there were trailing - * "::"s after the namespace's name which we ignore. The new namespace - * was already (recursively) created and is pointed to by parentPtr. - */ + /* + * If the unqualified name at the end is empty, there were trailing "::"s + * after the namespace's name which we ignore. The new namespace was + * already (recursively) created and is pointed to by parentPtr. + */ - if (*simpleName == '\0') { - return (Tcl_Namespace *) parentPtr; - } + if (*simpleName == '\0') { + Tcl_DStringFree(&tmpBuffer); + return (Tcl_Namespace *) parentPtr; + } - /* - * Check for a bad namespace name and make sure that the name does not - * already exist in the parent namespace. - */ + /* + * Check for a bad namespace name and make sure that the name does not + * already exist in the parent namespace. + */ - if ( + if ( #ifndef BREAK_NAMESPACE_COMPAT - Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL + Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL #else - parentPtr->childTablePtr != NULL && - Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL + parentPtr->childTablePtr != NULL && + Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL #endif - ) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create namespace \"%s\": already exists", name)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", - "CREATEEXISTING", NULL); - return NULL; - } + ) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "can't create namespace \"%s\": already exists", name)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE", + "CREATEEXISTING", NULL); + Tcl_DStringFree(&tmpBuffer); + return NULL; } /* @@ -736,6 +769,7 @@ Tcl_CreateNamespace( * of namespaces created. */ + doCreate: nsPtr = ckalloc(sizeof(Namespace)); nameLen = strlen(simpleName) + 1; nsPtr->name = ckalloc(nameLen); @@ -831,6 +865,7 @@ Tcl_CreateNamespace( Tcl_DStringFree(&buffer1); Tcl_DStringFree(&buffer2); + Tcl_DStringFree(&tmpBuffer); /* * If compilation of commands originating from the parent NS is diff --git a/generic/tclNotify.c b/generic/tclNotify.c index a6523fc..e76bca8 100644 --- a/generic/tclNotify.c +++ b/generic/tclNotify.c @@ -813,11 +813,7 @@ Tcl_SetMaxBlockTime( */ if (!tsdPtr->inTraversal) { - if (tsdPtr->blockTimeSet) { - Tcl_SetTimer(&tsdPtr->blockTime); - } else { - Tcl_SetTimer(NULL); - } + Tcl_SetTimer(&tsdPtr->blockTime); } } diff --git a/generic/tclOO.c b/generic/tclOO.c index cb22de6..9a0682d 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -271,7 +271,7 @@ TclOOInit( return TCL_ERROR; } - return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_VERSION, + return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL, (ClientData) &tclOOStubs); } @@ -437,10 +437,11 @@ InitFoundation( * ensemble. */ - Tcl_CreateObjCommand(interp, "::oo::Helpers::next", TclOONextObjCmd, NULL, - NULL); - Tcl_CreateObjCommand(interp, "::oo::Helpers::nextto", TclOONextToObjCmd, - NULL, NULL); + cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next", + NULL, TclOONextObjCmd, NULL, NULL); + cmdPtr->compileProc = TclCompileObjectNextCmd; + Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto", + NULL, TclOONextToObjCmd, NULL, NULL); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self", TclOOSelfObjCmd, NULL, NULL); cmdPtr->compileProc = TclCompileObjectSelfCmd; diff --git a/generic/tclOO.decls b/generic/tclOO.decls index 31d1113..5d6f2c2 100644 --- a/generic/tclOO.decls +++ b/generic/tclOO.decls @@ -1,12 +1,23 @@ +# tclOO.decls -- +# +# This file contains the declarations for all supported public functions +# that are exported by the TclOO package that is embedded within the Tcl +# library via the stubs table. This file is used to generate the +# tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files. +# +# Copyright (c) 2008-2013 by Donal K. Fellows. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + library tclOO ###################################################################### -# public API +# Public API, exposed for general users of TclOO. # interface tclOO hooks tclOOInt -scspec TCLOOAPI declare 0 { Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, @@ -116,7 +127,9 @@ declare 28 { } ###################################################################### -# private API, exposed to support advanced OO systems that plug in on top +# Private API, exposed to support advanced OO systems that plug in on top of +# TclOO; not intended for general use and does not have any commitment to +# long-term support. # interface tclOOInt diff --git a/generic/tclOO.h b/generic/tclOO.h index d5ab8a0..a6e8a22 100644 --- a/generic/tclOO.h +++ b/generic/tclOO.h @@ -12,21 +12,6 @@ #ifndef TCLOO_H_INCLUDED #define TCLOO_H_INCLUDED -#include "tcl.h" - -#ifndef TCLOOAPI -# if defined(BUILD_tcl) || defined(BUILD_TclOO) -# define TCLOOAPI MODULE_SCOPE -# else -# define TCLOOAPI extern -# undef USE_TCLOO_STUBS -# define USE_TCLOO_STUBS 1 -# endif -#endif - -extern const char *TclOOInitializeStubs( - Tcl_Interp *, const char *version); -#define Tcl_OOInitStubs(interp) TclOOInitializeStubs((interp), TCLOO_VERSION) /* * Be careful when it comes to versioning; need to make sure that the @@ -42,6 +27,24 @@ extern const char *TclOOInitializeStubs( #define TCLOO_VERSION "1.0.1" #define TCLOO_PATCHLEVEL TCLOO_VERSION +#include "tcl.h" + +/* + * For C++ compilers, use extern "C" + */ + +#ifdef __cplusplus +extern "C" { +#endif + +extern const char *TclOOInitializeStubs( + Tcl_Interp *, const char *version); +#define Tcl_OOInitStubs(interp) \ + TclOOInitializeStubs((interp), TCLOO_VERSION) +#ifndef USE_TCL_STUBS +# define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL) +#endif + /* * These are opaque types. */ @@ -130,6 +133,9 @@ typedef struct { #include "tclOODecls.h" +#ifdef __cplusplus +} +#endif #endif /* diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 853e2ec..6084cf2 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -17,16 +17,11 @@ #include "tclOOInt.h" static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp); -static int AfterNRDestructor(ClientData data[], - Tcl_Interp *interp, int result); -static int DecrRefsPostClassConstructor(ClientData data[], - Tcl_Interp *interp, int result); -static int FinalizeConstruction(ClientData data[], - Tcl_Interp *interp, int result); -static int FinalizeEval(ClientData data[], - Tcl_Interp *interp, int result); -static int RestoreFrame(ClientData data[], - Tcl_Interp *interp, int result); +static Tcl_NRPostProc AfterNRDestructor; +static Tcl_NRPostProc DecrRefsPostClassConstructor; +static Tcl_NRPostProc FinalizeConstruction; +static Tcl_NRPostProc FinalizeEval; +static Tcl_NRPostProc NextRestoreFrame; /* * ---------------------------------------------------------------------- @@ -808,7 +803,7 @@ TclOONextObjCmd( * that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); + TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } @@ -877,8 +872,8 @@ TclOONextToObjCmd( * context. Note that this is like [uplevel 1] and not [eval]. */ - TclNRAddCallback(interp, RestoreFrame, framePtr, contextPtr, - INT2PTR(contextPtr->index), NULL); + TclNRAddCallback(interp, NextRestoreFrame, framePtr, + contextPtr, INT2PTR(contextPtr->index), NULL); contextPtr->index = i-1; iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, @@ -908,7 +903,7 @@ TclOONextToObjCmd( } static int -RestoreFrame( +NextRestoreFrame( ClientData data[], Tcl_Interp *interp, int result) diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h index 58871c6..d3b9e59 100644 --- a/generic/tclOODecls.h +++ b/generic/tclOODecls.h @@ -5,99 +5,116 @@ #ifndef _TCLOODECLS #define _TCLOODECLS +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# undef USE_TCLOO_STUBS +# define USE_TCLOO_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ /* 0 */ -TCLOOAPI Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 1 */ -TCLOOAPI Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); +EXTERN Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz); /* 2 */ -TCLOOAPI Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); +EXTERN Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object); /* 3 */ -TCLOOAPI Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); +EXTERN Tcl_Command Tcl_GetObjectCommand(Tcl_Object object); /* 4 */ -TCLOOAPI Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr); /* 5 */ -TCLOOAPI Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); +EXTERN Tcl_Namespace * Tcl_GetObjectNamespace(Tcl_Object object); /* 6 */ -TCLOOAPI Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); +EXTERN Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method); /* 7 */ -TCLOOAPI Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); +EXTERN Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method); /* 8 */ -TCLOOAPI int Tcl_MethodIsPublic(Tcl_Method method); +EXTERN int Tcl_MethodIsPublic(Tcl_Method method); /* 9 */ -TCLOOAPI int Tcl_MethodIsType(Tcl_Method method, +EXTERN int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 10 */ -TCLOOAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method); +EXTERN Tcl_Obj * Tcl_MethodName(Tcl_Method method); /* 11 */ -TCLOOAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, +EXTERN Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */ -TCLOOAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, +EXTERN Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 13 */ -TCLOOAPI Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, +EXTERN Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 14 */ -TCLOOAPI int Tcl_ObjectDeleted(Tcl_Object object); +EXTERN int Tcl_ObjectDeleted(Tcl_Object object); /* 15 */ -TCLOOAPI int Tcl_ObjectContextIsFiltering( +EXTERN int Tcl_ObjectContextIsFiltering( Tcl_ObjectContext context); /* 16 */ -TCLOOAPI Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); +EXTERN Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context); /* 17 */ -TCLOOAPI Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); +EXTERN Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context); /* 18 */ -TCLOOAPI int Tcl_ObjectContextSkippedArgs( +EXTERN int Tcl_ObjectContextSkippedArgs( Tcl_ObjectContext context); /* 19 */ -TCLOOAPI ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, +EXTERN ClientData Tcl_ClassGetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 20 */ -TCLOOAPI void Tcl_ClassSetMetadata(Tcl_Class clazz, +EXTERN void Tcl_ClassSetMetadata(Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 21 */ -TCLOOAPI ClientData Tcl_ObjectGetMetadata(Tcl_Object object, +EXTERN ClientData Tcl_ObjectGetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 22 */ -TCLOOAPI void Tcl_ObjectSetMetadata(Tcl_Object object, +EXTERN void Tcl_ObjectSetMetadata(Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, ClientData metadata); /* 23 */ -TCLOOAPI int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, +EXTERN int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 24 */ -TCLOOAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( +EXTERN Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper( Tcl_Object object); /* 25 */ -TCLOOAPI void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, +EXTERN void Tcl_ObjectSetMethodNameMapper(Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 26 */ -TCLOOAPI void Tcl_ClassSetConstructor(Tcl_Interp *interp, +EXTERN void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */ -TCLOOAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp, +EXTERN void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 28 */ -TCLOOAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, +EXTERN Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object); typedef struct { @@ -139,10 +156,8 @@ typedef struct TclOOStubs { Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */ } TclOOStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclOOStubs *tclOOStubsPtr; + #ifdef __cplusplus } #endif @@ -215,4 +230,7 @@ extern const TclOOStubs *tclOOStubsPtr; #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOODECLS */ diff --git a/generic/tclOOIntDecls.h b/generic/tclOOIntDecls.h index acafb18..4f70e5b 100644 --- a/generic/tclOOIntDecls.h +++ b/generic/tclOOIntDecls.h @@ -5,53 +5,68 @@ #ifndef _TCLOOINTDECLS #define _TCLOOINTDECLS +#undef TCL_STORAGE_CLASS +#ifdef BUILD_tcl +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifdef USE_TCL_STUBS +# define TCL_STORAGE_CLASS +# else +# define TCL_STORAGE_CLASS DLLIMPORT +# endif +#endif + /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ /* 0 */ -TCLOOAPI Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); +EXTERN Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp); /* 1 */ -TCLOOAPI Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, +EXTERN Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 2 */ -TCLOOAPI Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, +EXTERN Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, ClientData clientData, Proc **procPtrPtr); /* 3 */ -TCLOOAPI Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */ -TCLOOAPI Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, +EXTERN Method * TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 5 */ -TCLOOAPI int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, +EXTERN int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 6 */ -TCLOOAPI int TclOOIsReachable(Class *targetPtr, Class *startPtr); +EXTERN int TclOOIsReachable(Class *targetPtr, Class *startPtr); /* 7 */ -TCLOOAPI Method * TclOONewForwardMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */ -TCLOOAPI Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, +EXTERN Method * TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 9 */ -TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, +EXTERN Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -60,7 +75,7 @@ TCLOOAPI Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */ -TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, +EXTERN Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, @@ -69,22 +84,22 @@ TCLOOAPI Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 11 */ -TCLOOAPI int TclOOInvokeObject(Tcl_Interp *interp, +EXTERN int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 12 */ -TCLOOAPI void TclOOObjectSetFilters(Object *oPtr, int numFilters, +EXTERN void TclOOObjectSetFilters(Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */ -TCLOOAPI void TclOOClassSetFilters(Tcl_Interp *interp, +EXTERN void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 14 */ -TCLOOAPI void TclOOObjectSetMixins(Object *oPtr, int numMixins, +EXTERN void TclOOObjectSetMixins(Object *oPtr, int numMixins, Class *const *mixins); /* 15 */ -TCLOOAPI void TclOOClassSetMixins(Tcl_Interp *interp, +EXTERN void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); @@ -110,10 +125,8 @@ typedef struct TclOOIntStubs { void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */ } TclOOIntStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclOOIntStubs *tclOOIntStubsPtr; + #ifdef __cplusplus } #endif @@ -160,4 +173,7 @@ extern const TclOOIntStubs *tclOOIntStubsPtr; #endif /* defined(USE_TCLOO_STUBS) */ /* !END!: Do not edit above this line. */ + +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TCLOOINTDECLS */ diff --git a/generic/tclOOStubLib.c b/generic/tclOOStubLib.c index 921aced..a9fa212 100644 --- a/generic/tclOOStubLib.c +++ b/generic/tclOOStubLib.c @@ -27,6 +27,8 @@ const TclOOIntStubs *tclOOIntStubsPtr = NULL; *---------------------------------------------------------------------- */ +#undef TclOOInitializeStubs + MODULE_SCOPE const char * TclOOInitializeStubs( Tcl_Interp *interp, diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index b7f4173..827d89d 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -191,7 +191,7 @@ TrimUnreachable( * ConvertZeroEffectToNOP -- * * Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also - * replace PUSH empty/CONCAT and TRY_CVT_NUMERIC (when followed by an + * replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an * operation that guarantees the check for arithmeticity) and eliminate * LNOT when we can invert the following JUMP condition. * @@ -227,7 +227,7 @@ ConvertZeroEffectToNOP( case INST_PUSH1: if (nextInst == INST_POP) { blank = size + InstLength(nextInst); - } else if (nextInst == INST_CONCAT1 + } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt1AtPtr(currentInstPtr + 1)); @@ -242,7 +242,7 @@ ConvertZeroEffectToNOP( case INST_PUSH4: if (nextInst == INST_POP) { blank = size + 1; - } else if (nextInst == INST_CONCAT1 + } else if (nextInst == INST_STR_CONCAT1 && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) { Tcl_Obj *litPtr = TclFetchLiteral(envPtr, TclGetUInt4AtPtr(currentInstPtr + 1)); @@ -344,21 +344,28 @@ AdvanceJumps( CompileEnv *envPtr) { unsigned char *currentInstPtr; + Tcl_HashTable jumps; for (currentInstPtr = envPtr->codeStart ; currentInstPtr < envPtr->codeNext-1 ; currentInstPtr += AddrLength(currentInstPtr)) { - int offset, delta; + int offset, delta, isNew; switch (*currentInstPtr) { case INST_JUMP1: case INST_JUMP_TRUE1: case INST_JUMP_FALSE1: offset = TclGetInt1AtPtr(currentInstPtr + 1); + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); for (delta=0 ; offset+delta != 0 ;) { if (offset + delta < -128 || offset + delta > 127) { break; } + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt1AtPtr(currentInstPtr + 1); + break; + } offset += delta; switch (*(currentInstPtr + offset)) { case INST_NOP: @@ -373,13 +380,21 @@ AdvanceJumps( } break; } + Tcl_DeleteHashTable(&jumps); TclStoreInt1AtPtr(offset, currentInstPtr + 1); continue; case INST_JUMP4: case INST_JUMP_TRUE4: case INST_JUMP_FALSE4: + Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS); + Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew); for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) { + Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew); + if (!isNew) { + offset = TclGetInt4AtPtr(currentInstPtr + 1); + break; + } switch (*(currentInstPtr + offset)) { case INST_NOP: offset += InstLength(INST_NOP); @@ -393,6 +408,7 @@ AdvanceJumps( } break; } + Tcl_DeleteHashTable(&jumps); TclStoreInt4AtPtr(offset, currentInstPtr + 1); continue; } @@ -411,7 +427,7 @@ AdvanceJumps( void TclOptimizeBytecode( - CompileEnv *envPtr) + void *envPtr) { ConvertZeroEffectToNOP(envPtr); AdvanceJumps(envPtr); diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index e9b92fe..681854d 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -42,6 +42,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -81,10 +85,8 @@ typedef struct TclPlatStubs { #endif /* MACOSX */ } TclPlatStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclPlatStubs *tclPlatStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclProc.c b/generic/tclProc.c index a154afa..42c9a72 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1851,9 +1851,39 @@ InterpProcNR2( } /* - * Process the result code. + * Free the stack-allocated compiled locals and CallFrame. It is important + * to pop the call frame without freeing it first: the compiledLocals + * cannot be freed before the frame is popped, as the local variables must + * be deleted. But the compiledLocals must be freed first, as they were + * allocated later on the stack. + */ + + if (result != TCL_OK) { + goto process; + } + + done: + if (TCL_DTRACE_PROC_RESULT_ENABLED()) { + int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; + Tcl_Obj *r = Tcl_GetObjResult(interp); + + TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ? + TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result, + TclGetString(r), r); + } + + freePtr = iPtr->framePtr; + Tcl_PopCallFrame(interp); /* Pop but do not free. */ + TclStackFree(interp, freePtr->compiledLocals); + /* Free compiledLocals. */ + TclStackFree(interp, freePtr); /* Free CallFrame. */ + return result; + + /* + * Process any non-TCL_OK result code. */ + process: switch (result) { case TCL_RETURN: /* @@ -1888,46 +1918,8 @@ InterpProcNR2( */ errorProc(interp, procNameObj); - - default: - /* - * Process other results (OK and non-standard) by doing nothing - * special, skipping directly to the code afterwards that cleans up - * associated memory. - * - * Non-standard results are processed by passing them through quickly. - * This means they all work as exceptions, unwinding the stack quickly - * and neatly. Who knows how well they are handled by third-party code - * though... - */ - - (void) 0; /* do nothing */ - } - - if (TCL_DTRACE_PROC_RESULT_ENABLED()) { - int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0; - Tcl_Obj *r = Tcl_GetObjResult(interp); - - TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ? - TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result, - TclGetString(r), r); } - - /* - * Free the stack-allocated compiled locals and CallFrame. It is important - * to pop the call frame without freeing it first: the compiledLocals - * cannot be freed before the frame is popped, as the local variables must - * be deleted. But the compiledLocals must be freed first, as they were - * allocated later on the stack. - */ - - freePtr = iPtr->framePtr; - Tcl_PopCallFrame(interp); /* Pop but do not free. */ - TclStackFree(interp, freePtr->compiledLocals); - /* Free compiledLocals. */ - TclStackFree(interp, freePtr); /* Free CallFrame. */ - - return result; + goto done; } /* diff --git a/generic/tclScan.c b/generic/tclScan.c index ef7eedf..4dfc2d6 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -406,11 +406,14 @@ ValidateFormat( */ case 'd': case 'e': + case 'E': case 'f': case 'g': + case 'G': case 'i': case 'o': case 'x': + case 'X': case 'b': break; case 'u': @@ -743,6 +746,7 @@ Tcl_ScanObjCmd( parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': + case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; @@ -758,7 +762,9 @@ Tcl_ScanObjCmd( case 'f': case 'e': + case 'E': case 'g': + case 'G': op = 'f'; break; diff --git a/generic/tclStringTrim.h b/generic/tclStringTrim.h new file mode 100644 index 0000000..669f10b --- /dev/null +++ b/generic/tclStringTrim.h @@ -0,0 +1,68 @@ +/* + * tclStringTrim.h -- + * + * This file contains the definition of what characters are to be trimmed + * from a string by [string trim] by default. It's only needed by Tcl's + * implementation; it does not form a public or private API at all. + * + * Copyright (c) 1987-1993 The Regents of the University of California. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 1998-2000 Scriptics Corporation. + * Copyright (c) 2002 ActiveState Corporation. + * Copyright (c) 2003-2013 Donal K. Fellows. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#ifndef TCL_STRING_TRIM_H +#define TCL_STRING_TRIM_H + +/* + * Default set of characters to trim in [string trim] and friends. This is a + * UTF-8 literal string containing all Unicode space characters. [TIP #413] + */ + +#define DEFAULT_TRIM_SET \ + "\x09\x0a\x0b\x0c\x0d " /* ASCII */\ + "\xc0\x80" /* nul (U+0000) */\ + "\xc2\x85" /* next line (U+0085) */\ + "\xc2\xa0" /* non-breaking space (U+00a0) */\ + "\xe1\x9a\x80" /* ogham space mark (U+1680) */ \ + "\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */\ + "\xe2\x80\x80" /* en quad (U+2000) */\ + "\xe2\x80\x81" /* em quad (U+2001) */\ + "\xe2\x80\x82" /* en space (U+2002) */\ + "\xe2\x80\x83" /* em space (U+2003) */\ + "\xe2\x80\x84" /* three-per-em space (U+2004) */\ + "\xe2\x80\x85" /* four-per-em space (U+2005) */\ + "\xe2\x80\x86" /* six-per-em space (U+2006) */\ + "\xe2\x80\x87" /* figure space (U+2007) */\ + "\xe2\x80\x88" /* punctuation space (U+2008) */\ + "\xe2\x80\x89" /* thin space (U+2009) */\ + "\xe2\x80\x8a" /* hair space (U+200a) */\ + "\xe2\x80\x8b" /* zero width space (U+200b) */\ + "\xe2\x80\xa8" /* line separator (U+2028) */\ + "\xe2\x80\xa9" /* paragraph separator (U+2029) */\ + "\xe2\x80\xaf" /* narrow no-break space (U+202f) */\ + "\xe2\x81\x9f" /* medium mathematical space (U+205f) */\ + "\xe2\x81\xa0" /* word joiner (U+2060) */\ + "\xe3\x80\x80" /* ideographic space (U+3000) */\ + "\xef\xbb\xbf" /* zero width no-break space (U+feff) */ + +/* + * The whitespace trimming set used when [concat]enating. This is a subset of + * the above, and deliberately so. + */ + +#define CONCAT_TRIM_SET " \f\v\r\t\n" + +#endif /* TCL_STRING_TRIM_H */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 782bbdf..e1918ef 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -234,9 +234,8 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){ && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } @@ -251,9 +250,8 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){ && (longValue <= (long)(UINT_MAX))) { *ptr = (int)longValue; } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "integer value too large to represent as non-long integer", -1)); result = TCL_ERROR; } } @@ -553,6 +551,7 @@ static const TclIntStubs tclIntStubs = { TclCopyChannel, /* 248 */ TclDoubleDigits, /* 249 */ TclSetSlaveCancelFlags, /* 250 */ + TclRegisterLiteral, /* 251 */ }; static const TclIntPlatStubs tclIntPlatStubs = { diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h index ef22153..69b095c 100644 --- a/generic/tclTomMathDecls.h +++ b/generic/tclTomMathDecls.h @@ -134,6 +134,10 @@ /* !BEGIN!: Do not edit below this line. */ +#ifdef __cplusplus +extern "C" { +#endif + /* * Exported function declarations: */ @@ -346,10 +350,8 @@ typedef struct TclTomMathStubs { int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */ } TclTomMathStubs; -#ifdef __cplusplus -extern "C" { -#endif extern const TclTomMathStubs *tclTomMathStubsPtr; + #ifdef __cplusplus } #endif diff --git a/generic/tclUniData.c b/generic/tclUniData.c index 5c88639..a0d4ccc 100644 --- a/generic/tclUniData.c +++ b/generic/tclUniData.c @@ -624,7 +624,7 @@ static const unsigned char groupMap[] = { 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 0, 7, 7, 7, 3, 3, - 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 0, + 4, 3, 3, 14, 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 86, 86, 86, 86, @@ -792,118 +792,118 @@ static const unsigned char groupMap[] = { 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 3, 3, 3, 85, 3, 3, 3, 4, 15, 86, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, - 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 2, 0, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15, + 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 86, 86, 86, 17, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 85, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, - 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, 0, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, + 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 15, 0, 0, 0, 0, + 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, + 86, 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, + 116, 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 0, 0, 0, 86, 86, 86, 116, 116, 116, 116, 86, - 86, 116, 116, 116, 0, 0, 0, 0, 116, 116, 86, 116, 116, 116, 116, 116, - 116, 86, 86, 86, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, - 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, 116, 116, 116, - 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 15, 15, 15, - 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 116, 116, 116, + 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, 116, + 15, 15, 15, 15, 15, 15, 15, 116, 116, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, 116, 116, - 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, 86, 86, - 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, - 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 86, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, 3, 3, 3, - 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, - 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 116, - 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, 116, 116, - 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, 15, 15, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, 116, 116, - 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, 116, 116, - 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, 116, - 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, - 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, 86, 86, - 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, + 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 86, 86, 116, + 116, 86, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 116, 86, 116, 86, 86, 86, 86, 86, + 86, 86, 0, 86, 116, 86, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 116, + 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, + 0, 86, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 85, 3, 3, + 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, + 86, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 86, 116, 86, 86, 86, 86, 86, 116, 86, 116, 116, 116, 116, 116, 86, + 116, 116, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 86, 86, 86, 86, 86, 86, 86, 86, 86, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 0, 0, 0, 86, 86, 116, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 116, 86, 86, 86, 86, 116, 116, 86, 86, 116, 86, 116, 116, + 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 86, 116, 86, 86, 116, 116, 116, 86, 116, 86, 86, 86, + 116, 116, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 116, + 116, 116, 116, 116, 116, 116, 116, 86, 86, 86, 86, 86, 86, 86, 86, + 116, 116, 86, 86, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 85, 85, 85, 85, 85, 85, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 3, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 116, 86, 86, 86, 86, 86, + 86, 86, 15, 15, 15, 15, 86, 15, 15, 15, 15, 116, 116, 86, 15, 15, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, + 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 21, 21, 21, 21, 21, 21, + 21, 21, 21, 21, 21, 21, 21, 85, 119, 21, 21, 21, 120, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, - 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, 86, 86, - 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, - 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, 21, - 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, 124, - 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, 124, - 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, - 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, 123, - 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, - 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, 123, - 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, 123, - 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, 126, - 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, 123, - 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, 123, - 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, - 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, - 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, 133, - 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, 136, - 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, 137, - 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, 138, - 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, 140, - 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17, - 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3, - 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17, - 17, 17, 0, 0, 0, 0, 0, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, 18, 18, - 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, 18, 18, - 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, - 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, 86, - 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, 86, 86, - 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, 100, - 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, 100, - 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, 100, - 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, 21, - 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, 147, - 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, - 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, - 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, - 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, 18, - 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14, - 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, + 21, 21, 21, 21, 21, 21, 21, 21, 85, 85, 85, 85, 85, 86, 86, 86, 86, + 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 86, 86, 86, 86, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, + 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 121, 21, + 21, 122, 21, 123, 123, 123, 123, 123, 123, 123, 123, 124, 124, 124, + 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 0, 0, 124, 124, + 124, 124, 124, 124, 0, 0, 123, 123, 123, 123, 123, 123, 123, 123, 124, + 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, 123, 123, + 123, 124, 124, 124, 124, 124, 124, 124, 124, 123, 123, 123, 123, 123, + 123, 0, 0, 124, 124, 124, 124, 124, 124, 0, 0, 21, 123, 21, 123, 21, + 123, 21, 123, 0, 124, 0, 124, 0, 124, 0, 124, 123, 123, 123, 123, 123, + 123, 123, 123, 124, 124, 124, 124, 124, 124, 124, 124, 125, 125, 126, + 126, 126, 126, 127, 127, 128, 128, 129, 129, 130, 130, 0, 0, 123, 123, + 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, 131, 131, + 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, 131, 131, + 131, 131, 123, 123, 123, 123, 123, 123, 123, 123, 131, 131, 131, 131, + 131, 131, 131, 131, 123, 123, 21, 132, 21, 0, 21, 21, 124, 124, 133, + 133, 134, 11, 135, 11, 11, 11, 21, 132, 21, 0, 21, 21, 136, 136, 136, + 136, 134, 11, 11, 11, 123, 123, 21, 21, 0, 0, 21, 21, 124, 124, 137, + 137, 0, 11, 11, 11, 123, 123, 21, 21, 21, 106, 21, 21, 124, 124, 138, + 138, 109, 11, 11, 11, 0, 0, 21, 132, 21, 0, 21, 21, 139, 139, 140, + 140, 134, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, + 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, + 3, 3, 3, 3, 3, 141, 142, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, + 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 85, 0, 0, + 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 85, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86, 86, 86, 86, 86, 86, 86, 86, 86, + 86, 86, 86, 86, 111, 111, 111, 111, 86, 111, 111, 111, 86, 86, 86, + 86, 86, 86, 86, 86, 86, 86, 86, 86, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 14, 14, 100, 14, 14, 14, 14, 100, 14, 14, 21, 100, 100, + 100, 21, 21, 100, 100, 100, 21, 14, 100, 14, 14, 7, 100, 100, 100, + 100, 100, 14, 14, 14, 14, 14, 14, 100, 14, 143, 14, 100, 14, 144, 145, + 100, 100, 14, 21, 100, 100, 146, 100, 21, 15, 15, 15, 15, 21, 14, 14, + 21, 21, 100, 100, 7, 7, 7, 7, 7, 100, 21, 21, 21, 21, 14, 7, 14, 14, + 147, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, 148, + 148, 148, 148, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, 149, + 149, 149, 149, 149, 149, 118, 118, 118, 23, 24, 118, 118, 118, 118, + 18, 0, 0, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, + 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, - 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7, - 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, + 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, - 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, diff --git a/generic/tclUtil.c b/generic/tclUtil.c index b089132..2d00adf 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -14,6 +14,7 @@ #include "tclInt.h" #include "tclParse.h" +#include "tclStringTrim.h" #include <math.h> /* @@ -1768,8 +1769,7 @@ TclTrimLeft( */ /* The whitespace characters trimmed during [concat] operations */ -#define CONCAT_WS " \f\v\r\t\n" -#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1) +#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_TRIM_SET "") - 1) char * Tcl_Concat( @@ -1825,7 +1825,8 @@ Tcl_Concat( * Trim away the leading whitespace. */ - trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); + trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); element += trim; elemLength -= trim; @@ -1834,7 +1835,8 @@ Tcl_Concat( * a final backslash character. */ - trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); + trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); trim -= trim && (element[elemLength - trim - 1] == '\\'); elemLength -= trim; @@ -1959,7 +1961,8 @@ Tcl_ConcatObj( * Trim away the leading whitespace. */ - trim = TclTrimLeft(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); + trim = TclTrimLeft(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); element += trim; elemLength -= trim; @@ -1968,7 +1971,8 @@ Tcl_ConcatObj( * a final backslash character. */ - trim = TclTrimRight(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE); + trim = TclTrimRight(element, elemLength, CONCAT_TRIM_SET, + CONCAT_WS_SIZE); trim -= trim && (element[elemLength - trim - 1] == '\\'); elemLength -= trim; diff --git a/generic/tclVar.c b/generic/tclVar.c index af1a563..4694cd8 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3850,6 +3850,53 @@ ArrayNamesCmd( /* *---------------------------------------------------------------------- * + * TclFindArrayPtrElements -- + * + * Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry + * for each existing element of the given array. The provided hash table + * is assumed to be initially empty. + * + * Result: + * none + * + * Side effects: + * The keys of the array gain an extra reference. The supplied hash table + * has elements added to it. + * + *---------------------------------------------------------------------- + */ + +void +TclFindArrayPtrElements( + Var *arrayPtr, + Tcl_HashTable *tablePtr) +{ + Var *varPtr; + Tcl_HashSearch search; + + if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr) + || TclIsVarUndefined(arrayPtr)) { + return; + } + + for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search); + varPtr!=NULL ; varPtr=VarHashNextVar(&search)) { + Tcl_HashEntry *hPtr; + Tcl_Obj *nameObj; + int dummy; + + if (TclIsVarUndefined(varPtr)) { + continue; + } + nameObj = VarHashGetKey(varPtr); + hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy); + Tcl_SetHashValue(hPtr, nameObj); + } +} + +/* + *---------------------------------------------------------------------- + * * ArraySetCmd -- * * This object-based function is invoked to process the "array set" Tcl diff --git a/library/http/http.tcl b/library/http/http.tcl index 3754f71..a6b2bfd 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.8.7 +package provide http 2.8.8 namespace eval http { # Allow resourcing to not clobber existing data @@ -113,7 +113,7 @@ if {[info command http::Log] eq {}} {proc http::Log {args} {}} proc http::register {proto port command} { variable urlTypes - set urlTypes($proto) [list $port $command] + set urlTypes([string tolower $proto]) [list $port $command] } # http::unregister -- @@ -127,11 +127,12 @@ proc http::register {proto port command} { proc http::unregister {proto} { variable urlTypes - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { return -code error "unsupported url type \"$proto\"" } - set old $urlTypes($proto) - unset urlTypes($proto) + set old $urlTypes($lower) + unset urlTypes($lower) return $old } @@ -514,12 +515,13 @@ proc http::geturl {url args} { if {$proto eq ""} { set proto http } - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } - set defport [lindex $urlTypes($proto) 0] - set defcmd [lindex $urlTypes($proto) 1] + set defport [lindex $urlTypes($lower) 0] + set defcmd [lindex $urlTypes($lower) 1] if {$port eq ""} { set port $defport @@ -650,7 +652,8 @@ proc http::Connected { token proto phost srvurl} { set host [lindex [split $state(socketinfo) :] 0] set port [lindex [split $state(socketinfo) :] 1] - set defport [lindex $urlTypes($proto) 0] + set lower [string tolower $proto] + set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index aaa3e85..27ba795 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6]} {return} -package ifneeded http 2.8.7 [list tclPkgSetup $dir http 2.8.7 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index 1ca6413..f63eedf 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -130,9 +130,9 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { switch -- $u { COMSPEC - PATH { - if {![info exists env($u)]} { - set env($u) $env($p) - } + set temp $env($p) + unset env($p) + set env($u) $temp trace add variable env($p) write \ [namespace code [list EnvTraceProc $p]] trace add variable env($u) write \ @@ -142,11 +142,7 @@ if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} { } } if {![info exists env(COMSPEC)]} { - if {$tcl_platform(os) eq "Windows NT"} { - set env(COMSPEC) cmd.exe - } else { - set env(COMSPEC) command.com - } + set env(COMSPEC) cmd.exe } } InitWinEnv diff --git a/library/parray.tcl b/library/parray.tcl index 3ce9817..a9c2cb1 100644 --- a/library/parray.tcl +++ b/library/parray.tcl @@ -11,7 +11,7 @@ proc parray {a {pattern *}} { upvar 1 $a array if {![array exists array]} { - error "\"$a\" isn't an array" + return -code error "\"$a\" isn't an array" } set maxl 0 set names [lsort [array names array $pattern]] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 60a9485..c99ad2a 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded tcltest 2.3.6 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.3.7 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index c30d2e4..4b94312 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -22,7 +22,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.3.6 + variable Version 2.3.7 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -2498,17 +2498,15 @@ proc tcltest::cleanupTests {{calledFromAllFile 0}} { if {![info exists originalEnv($index)]} { lappend newEnv $index unset ::env($index) - } else { - if {$::env($index) != $originalEnv($index)} { - lappend changedEnv $index - set ::env($index) $originalEnv($index) - } } } foreach index [array names originalEnv] { if {![info exists ::env($index)]} { lappend removedEnv $index set ::env($index) $originalEnv($index) + } elseif {$::env($index) ne $originalEnv($index)} { + lappend changedEnv $index + set ::env($index) $originalEnv($index) } } if {[llength $newEnv] > 0} { diff --git a/library/tzdata/Africa/Casablanca b/library/tzdata/Africa/Casablanca index 757007c..dec2778 100644 --- a/library/tzdata/Africa/Casablanca +++ b/library/tzdata/Africa/Casablanca @@ -36,189 +36,133 @@ set TZData(:Africa/Casablanca) { {1367114400 3600 1 WEST} {1373162400 0 0 WET} {1376100000 3600 1 WEST} - {1380420000 0 0 WET} - {1398564000 3600 1 WEST} + {1382839200 0 0 WET} + {1396144800 3600 1 WEST} {1404007200 0 0 WET} {1406599200 3600 1 WEST} - {1411869600 0 0 WET} - {1430013600 3600 1 WEST} + {1414288800 0 0 WET} + {1427594400 3600 1 WEST} {1434592800 0 0 WET} {1437184800 3600 1 WEST} - {1443319200 0 0 WET} - {1461463200 3600 1 WEST} + {1445738400 0 0 WET} + {1459044000 3600 1 WEST} {1465264800 0 0 WET} {1467856800 3600 1 WEST} - {1474768800 0 0 WET} - {1493517600 3600 1 WEST} + {1477792800 0 0 WET} + {1490493600 3600 1 WEST} {1495850400 0 0 WET} {1498442400 3600 1 WEST} - {1506218400 0 0 WET} - {1524967200 3600 1 WEST} + {1509242400 0 0 WET} + {1521943200 3600 1 WEST} {1526436000 0 0 WET} {1529028000 3600 1 WEST} - {1538272800 0 0 WET} - {1556416800 3600 1 WEST} + {1540692000 0 0 WET} + {1553997600 3600 1 WEST} {1557108000 0 0 WET} {1559700000 3600 1 WEST} - {1569722400 0 0 WET} + {1572141600 0 0 WET} + {1585447200 3600 1 WEST} + {1587693600 0 0 WET} {1590285600 3600 1 WEST} - {1601172000 0 0 WET} + {1603591200 0 0 WET} + {1616896800 3600 1 WEST} + {1618279200 0 0 WET} {1620871200 3600 1 WEST} - {1632621600 0 0 WET} + {1635645600 0 0 WET} + {1648346400 3600 1 WEST} + {1648951200 0 0 WET} {1651543200 3600 1 WEST} - {1664071200 0 0 WET} - {1682820000 3600 1 WEST} - {1695520800 0 0 WET} - {1714269600 3600 1 WEST} - {1727575200 0 0 WET} - {1745719200 3600 1 WEST} - {1759024800 0 0 WET} - {1777168800 3600 1 WEST} - {1790474400 0 0 WET} - {1808618400 3600 1 WEST} - {1821924000 0 0 WET} - {1840672800 3600 1 WEST} - {1853373600 0 0 WET} - {1872122400 3600 1 WEST} - {1885428000 0 0 WET} - {1903572000 3600 1 WEST} - {1916877600 0 0 WET} - {1935021600 3600 1 WEST} - {1948327200 0 0 WET} - {1966471200 3600 1 WEST} - {1979776800 0 0 WET} - {1997920800 3600 1 WEST} - {2011226400 0 0 WET} - {2029975200 3600 1 WEST} - {2042676000 0 0 WET} - {2061424800 3600 1 WEST} - {2074730400 0 0 WET} - {2092874400 3600 1 WEST} - {2106180000 0 0 WET} - {2124324000 3600 1 WEST} - {2137629600 0 0 WET} - {2155773600 3600 1 WEST} - {2169079200 0 0 WET} - {2187223200 3600 1 WEST} - {2200528800 0 0 WET} - {2219277600 3600 1 WEST} - {2232583200 0 0 WET} - {2250727200 3600 1 WEST} - {2264032800 0 0 WET} - {2282176800 3600 1 WEST} - {2295482400 0 0 WET} - {2313626400 3600 1 WEST} - {2326932000 0 0 WET} - {2345076000 3600 1 WEST} - {2358381600 0 0 WET} - {2377130400 3600 1 WEST} - {2389831200 0 0 WET} - {2408580000 3600 1 WEST} - {2421885600 0 0 WET} - {2440029600 3600 1 WEST} - {2453335200 0 0 WET} - {2471479200 3600 1 WEST} - {2484784800 0 0 WET} - {2502928800 3600 1 WEST} - {2516234400 0 0 WET} - {2534378400 3600 1 WEST} - {2547684000 0 0 WET} - {2566432800 3600 1 WEST} - {2579133600 0 0 WET} - {2597882400 3600 1 WEST} - {2611188000 0 0 WET} - {2629332000 3600 1 WEST} - {2642637600 0 0 WET} - {2660781600 3600 1 WEST} - {2674087200 0 0 WET} - {2692231200 3600 1 WEST} - {2705536800 0 0 WET} - {2724285600 3600 1 WEST} - {2736986400 0 0 WET} - {2755735200 3600 1 WEST} - {2769040800 0 0 WET} - {2787184800 3600 1 WEST} - {2800490400 0 0 WET} - {2818634400 3600 1 WEST} - {2831940000 0 0 WET} - {2850084000 3600 1 WEST} - {2863389600 0 0 WET} - {2881533600 3600 1 WEST} - {2894839200 0 0 WET} - {2913588000 3600 1 WEST} - {2926288800 0 0 WET} - {2945037600 3600 1 WEST} - {2958343200 0 0 WET} - {2976487200 3600 1 WEST} - {2989792800 0 0 WET} - {3007936800 3600 1 WEST} - {3021242400 0 0 WET} - {3039386400 3600 1 WEST} - {3052692000 0 0 WET} - {3070836000 3600 1 WEST} - {3084141600 0 0 WET} - {3102890400 3600 1 WEST} - {3116196000 0 0 WET} - {3134340000 3600 1 WEST} - {3147645600 0 0 WET} - {3165789600 3600 1 WEST} - {3179095200 0 0 WET} - {3197239200 3600 1 WEST} - {3210544800 0 0 WET} - {3228688800 3600 1 WEST} - {3241994400 0 0 WET} - {3260743200 3600 1 WEST} - {3273444000 0 0 WET} - {3292192800 3600 1 WEST} - {3305498400 0 0 WET} - {3323642400 3600 1 WEST} - {3336948000 0 0 WET} - {3355092000 3600 1 WEST} - {3368397600 0 0 WET} - {3386541600 3600 1 WEST} - {3399847200 0 0 WET} - {3417991200 3600 1 WEST} - {3431296800 0 0 WET} - {3450045600 3600 1 WEST} - {3462746400 0 0 WET} - {3481495200 3600 1 WEST} - {3494800800 0 0 WET} - {3512944800 3600 1 WEST} - {3526250400 0 0 WET} - {3544394400 3600 1 WEST} - {3557700000 0 0 WET} - {3575844000 3600 1 WEST} - {3589149600 0 0 WET} - {3607898400 3600 1 WEST} - {3620599200 0 0 WET} - {3639348000 3600 1 WEST} - {3652653600 0 0 WET} - {3670797600 3600 1 WEST} - {3684103200 0 0 WET} - {3702247200 3600 1 WEST} - {3715552800 0 0 WET} - {3733696800 3600 1 WEST} - {3747002400 0 0 WET} - {3765146400 3600 1 WEST} - {3778452000 0 0 WET} - {3797200800 3600 1 WEST} - {3809901600 0 0 WET} - {3828650400 3600 1 WEST} - {3841956000 0 0 WET} - {3860100000 3600 1 WEST} - {3873405600 0 0 WET} - {3891549600 3600 1 WEST} - {3904855200 0 0 WET} - {3922999200 3600 1 WEST} - {3936304800 0 0 WET} - {3954448800 3600 1 WEST} - {3967754400 0 0 WET} - {3986503200 3600 1 WEST} - {3999808800 0 0 WET} - {4017952800 3600 1 WEST} - {4031258400 0 0 WET} - {4049402400 3600 1 WEST} - {4062708000 0 0 WET} - {4080852000 3600 1 WEST} - {4094157600 0 0 WET} + {1667095200 0 0 WET} + {1682128800 3600 1 WEST} + {1698544800 0 0 WET} + {1712714400 3600 1 WEST} + {1729994400 0 0 WET} + {1743386400 3600 1 WEST} + {1761444000 0 0 WET} + {1774749600 3600 1 WEST} + {1792893600 0 0 WET} + {1806199200 3600 1 WEST} + {1824948000 0 0 WET} + {1837648800 3600 1 WEST} + {1856397600 0 0 WET} + {1869098400 3600 1 WEST} + {1887847200 0 0 WET} + {1901152800 3600 1 WEST} + {1919296800 0 0 WET} + {1932602400 3600 1 WEST} + {1950746400 0 0 WET} + {1964052000 3600 1 WEST} + {1982800800 0 0 WET} + {1995501600 3600 1 WEST} + {2014250400 0 0 WET} + {2026951200 3600 1 WEST} + {2045700000 0 0 WET} + {2058400800 3600 1 WEST} + {2077149600 0 0 WET} + {2090455200 3600 1 WEST} + {2108167200 0 0 WET} + {2121904800 3600 1 WEST} + {2138839200 0 0 WET} + {2153354400 3600 1 WEST} + {2184800400 3600 1 WEST} + {2216250000 3600 1 WEST} + {2248304400 3600 1 WEST} + {2279754000 3600 1 WEST} + {2311203600 3600 1 WEST} + {2342653200 3600 1 WEST} + {2374102800 3600 1 WEST} + {2405552400 3600 1 WEST} + {2437606800 3600 1 WEST} + {2469056400 3600 1 WEST} + {2500506000 3600 1 WEST} + {2531955600 3600 1 WEST} + {2563405200 3600 1 WEST} + {2595459600 3600 1 WEST} + {2626909200 3600 1 WEST} + {2658358800 3600 1 WEST} + {2689808400 3600 1 WEST} + {2721258000 3600 1 WEST} + {2752707600 3600 1 WEST} + {2784762000 3600 1 WEST} + {2816211600 3600 1 WEST} + {2847661200 3600 1 WEST} + {2879110800 3600 1 WEST} + {2910560400 3600 1 WEST} + {2942010000 3600 1 WEST} + {2974064400 3600 1 WEST} + {3005514000 3600 1 WEST} + {3036963600 3600 1 WEST} + {3068413200 3600 1 WEST} + {3099862800 3600 1 WEST} + {3131917200 3600 1 WEST} + {3163366800 3600 1 WEST} + {3194816400 3600 1 WEST} + {3226266000 3600 1 WEST} + {3257715600 3600 1 WEST} + {3289165200 3600 1 WEST} + {3321219600 3600 1 WEST} + {3352669200 3600 1 WEST} + {3384118800 3600 1 WEST} + {3415568400 3600 1 WEST} + {3447018000 3600 1 WEST} + {3479072400 3600 1 WEST} + {3510522000 3600 1 WEST} + {3541971600 3600 1 WEST} + {3573421200 3600 1 WEST} + {3604870800 3600 1 WEST} + {3636320400 3600 1 WEST} + {3668374800 3600 1 WEST} + {3699824400 3600 1 WEST} + {3731274000 3600 1 WEST} + {3762723600 3600 1 WEST} + {3794173200 3600 1 WEST} + {3825622800 3600 1 WEST} + {3857677200 3600 1 WEST} + {3889126800 3600 1 WEST} + {3920576400 3600 1 WEST} + {3952026000 3600 1 WEST} + {3983475600 3600 1 WEST} + {4015530000 3600 1 WEST} + {4046979600 3600 1 WEST} + {4078429200 3600 1 WEST} } diff --git a/library/tzdata/Africa/Juba b/library/tzdata/Africa/Juba index 7495981..40551f2 100644 --- a/library/tzdata/Africa/Juba +++ b/library/tzdata/Africa/Juba @@ -1,39 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Africa/Juba) { - {-9223372036854775808 7584 0 LMT} - {-1230775584 7200 0 CAT} - {10360800 10800 1 CAST} - {24786000 7200 0 CAT} - {41810400 10800 1 CAST} - {56322000 7200 0 CAT} - {73432800 10800 1 CAST} - {87944400 7200 0 CAT} - {104882400 10800 1 CAST} - {119480400 7200 0 CAT} - {136332000 10800 1 CAST} - {151016400 7200 0 CAT} - {167781600 10800 1 CAST} - {182552400 7200 0 CAT} - {199231200 10800 1 CAST} - {214174800 7200 0 CAT} - {230680800 10800 1 CAST} - {245710800 7200 0 CAT} - {262735200 10800 1 CAST} - {277246800 7200 0 CAT} - {294184800 10800 1 CAST} - {308782800 7200 0 CAT} - {325634400 10800 1 CAST} - {340405200 7200 0 CAT} - {357084000 10800 1 CAST} - {371941200 7200 0 CAT} - {388533600 10800 1 CAST} - {403477200 7200 0 CAT} - {419983200 10800 1 CAST} - {435013200 7200 0 CAT} - {452037600 10800 1 CAST} - {466635600 7200 0 CAT} - {483487200 10800 1 CAST} - {498171600 7200 0 CAT} - {947930400 10800 0 EAT} +if {![info exists TZData(Africa/Khartoum)]} { + LoadTimeZoneFile Africa/Khartoum } +set TZData(:Africa/Juba) $TZData(:Africa/Khartoum) diff --git a/library/tzdata/America/Anguilla b/library/tzdata/America/Anguilla index cfe7483..39a0d18 100644 --- a/library/tzdata/America/Anguilla +++ b/library/tzdata/America/Anguilla @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Anguilla) { - {-9223372036854775808 -15136 0 LMT} - {-1825098464 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Anguilla) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Araguaina b/library/tzdata/America/Araguaina index dc1b543..e4a0d52 100644 --- a/library/tzdata/America/Araguaina +++ b/library/tzdata/America/Araguaina @@ -56,177 +56,5 @@ set TZData(:America/Araguaina) { {1064368800 -10800 0 BRT} {1350788400 -7200 0 BRST} {1361066400 -10800 0 BRT} - {1382238000 -7200 1 BRST} - {1392516000 -10800 0 BRT} - {1413687600 -7200 1 BRST} - {1424570400 -10800 0 BRT} - {1445137200 -7200 1 BRST} - {1456020000 -10800 0 BRT} - {1476586800 -7200 1 BRST} - {1487469600 -10800 0 BRT} - {1508036400 -7200 1 BRST} - {1518919200 -10800 0 BRT} - {1540090800 -7200 1 BRST} - {1550368800 -10800 0 BRT} - {1571540400 -7200 1 BRST} - {1581818400 -10800 0 BRT} - {1602990000 -7200 1 BRST} - {1613872800 -10800 0 BRT} - {1634439600 -7200 1 BRST} - {1645322400 -10800 0 BRT} - {1665889200 -7200 1 BRST} - {1677376800 -10800 0 BRT} - {1697338800 -7200 1 BRST} - {1708221600 -10800 0 BRT} - {1729393200 -7200 1 BRST} - {1739671200 -10800 0 BRT} - {1760842800 -7200 1 BRST} - {1771725600 -10800 0 BRT} - {1792292400 -7200 1 BRST} - {1803175200 -10800 0 BRT} - {1823742000 -7200 1 BRST} - {1834624800 -10800 0 BRT} - {1855191600 -7200 1 BRST} - {1866074400 -10800 0 BRT} - {1887246000 -7200 1 BRST} - {1897524000 -10800 0 BRT} - {1918695600 -7200 1 BRST} - {1928973600 -10800 0 BRT} - {1950145200 -7200 1 BRST} - {1960423200 -10800 0 BRT} - {1981594800 -7200 1 BRST} - {1992477600 -10800 0 BRT} - {2013044400 -7200 1 BRST} - {2024532000 -10800 0 BRT} - {2044494000 -7200 1 BRST} - {2055376800 -10800 0 BRT} - {2076548400 -7200 1 BRST} - {2086826400 -10800 0 BRT} - {2107998000 -7200 1 BRST} - {2118880800 -10800 0 BRT} - {2139447600 -7200 1 BRST} - {2150330400 -10800 0 BRT} - {2170897200 -7200 1 BRST} - {2181780000 -10800 0 BRT} - {2202346800 -7200 1 BRST} - {2213229600 -10800 0 BRT} - {2234401200 -7200 1 BRST} - {2244679200 -10800 0 BRT} - {2265850800 -7200 1 BRST} - {2276128800 -10800 0 BRT} - {2297300400 -7200 1 BRST} - {2307578400 -10800 0 BRT} - {2328750000 -7200 1 BRST} - {2339632800 -10800 0 BRT} - {2360199600 -7200 1 BRST} - {2371082400 -10800 0 BRT} - {2391649200 -7200 1 BRST} - {2402532000 -10800 0 BRT} - {2423703600 -7200 1 BRST} - {2433981600 -10800 0 BRT} - {2455153200 -7200 1 BRST} - {2465431200 -10800 0 BRT} - {2486602800 -7200 1 BRST} - {2497485600 -10800 0 BRT} - {2518052400 -7200 1 BRST} - {2528935200 -10800 0 BRT} - {2549502000 -7200 1 BRST} - {2560384800 -10800 0 BRT} - {2580951600 -7200 1 BRST} - {2591834400 -10800 0 BRT} - {2613006000 -7200 1 BRST} - {2623284000 -10800 0 BRT} - {2644455600 -7200 1 BRST} - {2654733600 -10800 0 BRT} - {2675905200 -7200 1 BRST} - {2686788000 -10800 0 BRT} - {2707354800 -7200 1 BRST} - {2718237600 -10800 0 BRT} - {2738804400 -7200 1 BRST} - {2749687200 -10800 0 BRT} - {2770858800 -7200 1 BRST} - {2781136800 -10800 0 BRT} - {2802308400 -7200 1 BRST} - {2812586400 -10800 0 BRT} - {2833758000 -7200 1 BRST} - {2844036000 -10800 0 BRT} - {2865207600 -7200 1 BRST} - {2876090400 -10800 0 BRT} - {2896657200 -7200 1 BRST} - {2907540000 -10800 0 BRT} - {2928106800 -7200 1 BRST} - {2938989600 -10800 0 BRT} - {2960161200 -7200 1 BRST} - {2970439200 -10800 0 BRT} - {2991610800 -7200 1 BRST} - {3001888800 -10800 0 BRT} - {3023060400 -7200 1 BRST} - {3033943200 -10800 0 BRT} - {3054510000 -7200 1 BRST} - {3065392800 -10800 0 BRT} - {3085959600 -7200 1 BRST} - {3096842400 -10800 0 BRT} - {3118014000 -7200 1 BRST} - {3128292000 -10800 0 BRT} - {3149463600 -7200 1 BRST} - {3159741600 -10800 0 BRT} - {3180913200 -7200 1 BRST} - {3191191200 -10800 0 BRT} - {3212362800 -7200 1 BRST} - {3223245600 -10800 0 BRT} - {3243812400 -7200 1 BRST} - {3254695200 -10800 0 BRT} - {3275262000 -7200 1 BRST} - {3286144800 -10800 0 BRT} - {3307316400 -7200 1 BRST} - {3317594400 -10800 0 BRT} - {3338766000 -7200 1 BRST} - {3349044000 -10800 0 BRT} - {3370215600 -7200 1 BRST} - {3381098400 -10800 0 BRT} - {3401665200 -7200 1 BRST} - {3412548000 -10800 0 BRT} - {3433114800 -7200 1 BRST} - {3443997600 -10800 0 BRT} - {3464564400 -7200 1 BRST} - {3475447200 -10800 0 BRT} - {3496618800 -7200 1 BRST} - {3506896800 -10800 0 BRT} - {3528068400 -7200 1 BRST} - {3538346400 -10800 0 BRT} - {3559518000 -7200 1 BRST} - {3570400800 -10800 0 BRT} - {3590967600 -7200 1 BRST} - {3601850400 -10800 0 BRT} - {3622417200 -7200 1 BRST} - {3633300000 -10800 0 BRT} - {3654471600 -7200 1 BRST} - {3664749600 -10800 0 BRT} - {3685921200 -7200 1 BRST} - {3696199200 -10800 0 BRT} - {3717370800 -7200 1 BRST} - {3727648800 -10800 0 BRT} - {3748820400 -7200 1 BRST} - {3759703200 -10800 0 BRT} - {3780270000 -7200 1 BRST} - {3791152800 -10800 0 BRT} - {3811719600 -7200 1 BRST} - {3822602400 -10800 0 BRT} - {3843774000 -7200 1 BRST} - {3854052000 -10800 0 BRT} - {3875223600 -7200 1 BRST} - {3885501600 -10800 0 BRT} - {3906673200 -7200 1 BRST} - {3917556000 -10800 0 BRT} - {3938122800 -7200 1 BRST} - {3949005600 -10800 0 BRT} - {3969572400 -7200 1 BRST} - {3980455200 -10800 0 BRT} - {4001626800 -7200 1 BRST} - {4011904800 -10800 0 BRT} - {4033076400 -7200 1 BRST} - {4043354400 -10800 0 BRT} - {4064526000 -7200 1 BRST} - {4074804000 -10800 0 BRT} - {4095975600 -7200 1 BRST} + {1378000800 -10800 0 BRT} } diff --git a/library/tzdata/America/Argentina/San_Luis b/library/tzdata/America/Argentina/San_Luis index bec1554..8ca55d7 100644 --- a/library/tzdata/America/Argentina/San_Luis +++ b/library/tzdata/America/Argentina/San_Luis @@ -64,5 +64,5 @@ set TZData(:America/Argentina/San_Luis) { {1205031600 -14400 0 WART} {1223784000 -10800 1 WARST} {1236481200 -14400 0 WART} - {1255233600 -10800 1 WARST} + {1255233600 -10800 0 ART} } diff --git a/library/tzdata/America/Aruba b/library/tzdata/America/Aruba index 92f182d..e02d5fc 100644 --- a/library/tzdata/America/Aruba +++ b/library/tzdata/America/Aruba @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Aruba) { - {-9223372036854775808 -16824 0 LMT} - {-1826738376 -16200 0 ANT} - {-157750200 -14400 0 AST} +if {![info exists TZData(America/Curacao)]} { + LoadTimeZoneFile America/Curacao } +set TZData(:America/Aruba) $TZData(:America/Curacao) diff --git a/library/tzdata/America/Cayman b/library/tzdata/America/Cayman index ab5d12b..3e2e3cc 100644 --- a/library/tzdata/America/Cayman +++ b/library/tzdata/America/Cayman @@ -2,6 +2,6 @@ set TZData(:America/Cayman) { {-9223372036854775808 -19532 0 LMT} - {-2524502068 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-2524502068 -18431 0 KMT} + {-1827687169 -18000 0 EST} } diff --git a/library/tzdata/America/Dominica b/library/tzdata/America/Dominica index 3503a65..b97cb0e 100644 --- a/library/tzdata/America/Dominica +++ b/library/tzdata/America/Dominica @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Dominica) { - {-9223372036854775808 -14736 0 LMT} - {-1846266804 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Dominica) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Grand_Turk b/library/tzdata/America/Grand_Turk index a455dd5..6c8ea4a 100644 --- a/library/tzdata/America/Grand_Turk +++ b/library/tzdata/America/Grand_Turk @@ -2,8 +2,8 @@ set TZData(:America/Grand_Turk) { {-9223372036854775808 -17072 0 LMT} - {-2524504528 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-2524504528 -18431 0 KMT} + {-1827687169 -18000 0 EST} {294217200 -14400 1 EDT} {309938400 -18000 0 EST} {325666800 -14400 1 EDT} diff --git a/library/tzdata/America/Grenada b/library/tzdata/America/Grenada index 3c2919b..92300c3 100644 --- a/library/tzdata/America/Grenada +++ b/library/tzdata/America/Grenada @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Grenada) { - {-9223372036854775808 -14820 0 LMT} - {-1846266780 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Grenada) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Guadeloupe b/library/tzdata/America/Guadeloupe index b1987ce..aba6bd7 100644 --- a/library/tzdata/America/Guadeloupe +++ b/library/tzdata/America/Guadeloupe @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Guadeloupe) { - {-9223372036854775808 -14768 0 LMT} - {-1848254032 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Guadeloupe) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Jamaica b/library/tzdata/America/Jamaica index 393d90a8..682e47c 100644 --- a/library/tzdata/America/Jamaica +++ b/library/tzdata/America/Jamaica @@ -1,9 +1,9 @@ # created by tools/tclZIC.tcl - do not edit set TZData(:America/Jamaica) { - {-9223372036854775808 -18432 0 LMT} - {-2524503168 -18432 0 KMT} - {-1827687168 -18000 0 EST} + {-9223372036854775808 -18431 0 LMT} + {-2524503169 -18431 0 KMT} + {-1827687169 -18000 0 EST} {136364400 -14400 0 EDT} {152085600 -18000 0 EST} {162370800 -14400 1 EDT} diff --git a/library/tzdata/America/Marigot b/library/tzdata/America/Marigot index 9f3f8f6..c2b3873 100644 --- a/library/tzdata/America/Marigot +++ b/library/tzdata/America/Marigot @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Guadeloupe)]} { - LoadTimeZoneFile America/Guadeloupe +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/Marigot) $TZData(:America/Guadeloupe) +set TZData(:America/Marigot) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Montserrat b/library/tzdata/America/Montserrat index 4d82766..0a656d3 100644 --- a/library/tzdata/America/Montserrat +++ b/library/tzdata/America/Montserrat @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Montserrat) { - {-9223372036854775808 -14932 0 LMT} - {-1846266608 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Montserrat) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Barthelemy b/library/tzdata/America/St_Barthelemy index 25c114a..46bc287 100644 --- a/library/tzdata/America/St_Barthelemy +++ b/library/tzdata/America/St_Barthelemy @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/Guadeloupe)]} { - LoadTimeZoneFile America/Guadeloupe +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/St_Barthelemy) $TZData(:America/Guadeloupe) +set TZData(:America/St_Barthelemy) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Kitts b/library/tzdata/America/St_Kitts index bfd803b..6ad7f04 100644 --- a/library/tzdata/America/St_Kitts +++ b/library/tzdata/America/St_Kitts @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Kitts) { - {-9223372036854775808 -15052 0 LMT} - {-1825098548 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Kitts) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Lucia b/library/tzdata/America/St_Lucia index c2767dd..e479b31 100644 --- a/library/tzdata/America/St_Lucia +++ b/library/tzdata/America/St_Lucia @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Lucia) { - {-9223372036854775808 -14640 0 LMT} - {-2524506960 -14640 0 CMT} - {-1830369360 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Lucia) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Thomas b/library/tzdata/America/St_Thomas index bf93595..24698b8 100644 --- a/library/tzdata/America/St_Thomas +++ b/library/tzdata/America/St_Thomas @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Thomas) { - {-9223372036854775808 -15584 0 LMT} - {-1846266016 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Thomas) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/St_Vincent b/library/tzdata/America/St_Vincent index 3a884c7..e3b32fb 100644 --- a/library/tzdata/America/St_Vincent +++ b/library/tzdata/America/St_Vincent @@ -1,7 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/St_Vincent) { - {-9223372036854775808 -14696 0 LMT} - {-2524506904 -14696 0 KMT} - {-1830369304 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/St_Vincent) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Tortola b/library/tzdata/America/Tortola index bf7f1fc..aa6f655 100644 --- a/library/tzdata/America/Tortola +++ b/library/tzdata/America/Tortola @@ -1,6 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:America/Tortola) { - {-9223372036854775808 -15508 0 LMT} - {-1846266092 -14400 0 AST} +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } +set TZData(:America/Tortola) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/America/Virgin b/library/tzdata/America/Virgin index 390d7c2..c267e5b 100644 --- a/library/tzdata/America/Virgin +++ b/library/tzdata/America/Virgin @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(America/St_Thomas)]} { - LoadTimeZoneFile America/St_Thomas +if {![info exists TZData(America/Port_of_Spain)]} { + LoadTimeZoneFile America/Port_of_Spain } -set TZData(:America/Virgin) $TZData(:America/St_Thomas) +set TZData(:America/Virgin) $TZData(:America/Port_of_Spain) diff --git a/library/tzdata/Antarctica/McMurdo b/library/tzdata/Antarctica/McMurdo index 670f7eb..3b29ba1 100644 --- a/library/tzdata/Antarctica/McMurdo +++ b/library/tzdata/Antarctica/McMurdo @@ -1,257 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Antarctica/McMurdo) { - {-9223372036854775808 0 0 zzz} - {-441849600 43200 0 NZST} - {152632800 46800 1 NZDT} - {162309600 43200 0 NZST} - {183477600 46800 1 NZDT} - {194968800 43200 0 NZST} - {215532000 46800 1 NZDT} - {226418400 43200 0 NZST} - {246981600 46800 1 NZDT} - {257868000 43200 0 NZST} - {278431200 46800 1 NZDT} - {289317600 43200 0 NZST} - {309880800 46800 1 NZDT} - {320767200 43200 0 NZST} - {341330400 46800 1 NZDT} - {352216800 43200 0 NZST} - {372780000 46800 1 NZDT} - {384271200 43200 0 NZST} - {404834400 46800 1 NZDT} - {415720800 43200 0 NZST} - {436284000 46800 1 NZDT} - {447170400 43200 0 NZST} - {467733600 46800 1 NZDT} - {478620000 43200 0 NZST} - {499183200 46800 1 NZDT} - {510069600 43200 0 NZST} - {530632800 46800 1 NZDT} - {541519200 43200 0 NZST} - {562082400 46800 1 NZDT} - {573573600 43200 0 NZST} - {594136800 46800 1 NZDT} - {605023200 43200 0 NZST} - {623772000 46800 1 NZDT} - {637682400 43200 0 NZST} - {655221600 46800 1 NZDT} - {669132000 43200 0 NZST} - {686671200 46800 1 NZDT} - {700581600 43200 0 NZST} - {718120800 46800 1 NZDT} - {732636000 43200 0 NZST} - {749570400 46800 1 NZDT} - {764085600 43200 0 NZST} - {781020000 46800 1 NZDT} - {795535200 43200 0 NZST} - {812469600 46800 1 NZDT} - {826984800 43200 0 NZST} - {844524000 46800 1 NZDT} - {858434400 43200 0 NZST} - {875973600 46800 1 NZDT} - {889884000 43200 0 NZST} - {907423200 46800 1 NZDT} - {921938400 43200 0 NZST} - {938872800 46800 1 NZDT} - {953388000 43200 0 NZST} - {970322400 46800 1 NZDT} - {984837600 43200 0 NZST} - {1002376800 46800 1 NZDT} - {1016287200 43200 0 NZST} - {1033826400 46800 1 NZDT} - {1047736800 43200 0 NZST} - {1065276000 46800 1 NZDT} - {1079791200 43200 0 NZST} - {1096725600 46800 1 NZDT} - {1111240800 43200 0 NZST} - {1128175200 46800 1 NZDT} - {1142690400 43200 0 NZST} - {1159624800 46800 1 NZDT} - {1174140000 43200 0 NZST} - {1191074400 46800 1 NZDT} - {1207404000 43200 0 NZST} - {1222524000 46800 1 NZDT} - {1238853600 43200 0 NZST} - {1253973600 46800 1 NZDT} - {1270303200 43200 0 NZST} - {1285423200 46800 1 NZDT} - {1301752800 43200 0 NZST} - {1316872800 46800 1 NZDT} - {1333202400 43200 0 NZST} - {1348927200 46800 1 NZDT} - {1365256800 43200 0 NZST} - {1380376800 46800 1 NZDT} - {1396706400 43200 0 NZST} - {1411826400 46800 1 NZDT} - {1428156000 43200 0 NZST} - {1443276000 46800 1 NZDT} - {1459605600 43200 0 NZST} - {1474725600 46800 1 NZDT} - {1491055200 43200 0 NZST} - {1506175200 46800 1 NZDT} - {1522504800 43200 0 NZST} - {1538229600 46800 1 NZDT} - {1554559200 43200 0 NZST} - {1569679200 46800 1 NZDT} - {1586008800 43200 0 NZST} - {1601128800 46800 1 NZDT} - {1617458400 43200 0 NZST} - {1632578400 46800 1 NZDT} - {1648908000 43200 0 NZST} - {1664028000 46800 1 NZDT} - {1680357600 43200 0 NZST} - {1695477600 46800 1 NZDT} - {1712412000 43200 0 NZST} - {1727532000 46800 1 NZDT} - {1743861600 43200 0 NZST} - {1758981600 46800 1 NZDT} - {1775311200 43200 0 NZST} - {1790431200 46800 1 NZDT} - {1806760800 43200 0 NZST} - {1821880800 46800 1 NZDT} - {1838210400 43200 0 NZST} - {1853330400 46800 1 NZDT} - {1869660000 43200 0 NZST} - {1885384800 46800 1 NZDT} - {1901714400 43200 0 NZST} - {1916834400 46800 1 NZDT} - {1933164000 43200 0 NZST} - {1948284000 46800 1 NZDT} - {1964613600 43200 0 NZST} - {1979733600 46800 1 NZDT} - {1996063200 43200 0 NZST} - {2011183200 46800 1 NZDT} - {2027512800 43200 0 NZST} - {2042632800 46800 1 NZDT} - {2058962400 43200 0 NZST} - {2074687200 46800 1 NZDT} - {2091016800 43200 0 NZST} - {2106136800 46800 1 NZDT} - {2122466400 43200 0 NZST} - {2137586400 46800 1 NZDT} - {2153916000 43200 0 NZST} - {2169036000 46800 1 NZDT} - {2185365600 43200 0 NZST} - {2200485600 46800 1 NZDT} - {2216815200 43200 0 NZST} - {2232540000 46800 1 NZDT} - {2248869600 43200 0 NZST} - {2263989600 46800 1 NZDT} - {2280319200 43200 0 NZST} - {2295439200 46800 1 NZDT} - {2311768800 43200 0 NZST} - {2326888800 46800 1 NZDT} - {2343218400 43200 0 NZST} - {2358338400 46800 1 NZDT} - {2374668000 43200 0 NZST} - {2389788000 46800 1 NZDT} - {2406117600 43200 0 NZST} - {2421842400 46800 1 NZDT} - {2438172000 43200 0 NZST} - {2453292000 46800 1 NZDT} - {2469621600 43200 0 NZST} - {2484741600 46800 1 NZDT} - {2501071200 43200 0 NZST} - {2516191200 46800 1 NZDT} - {2532520800 43200 0 NZST} - {2547640800 46800 1 NZDT} - {2563970400 43200 0 NZST} - {2579090400 46800 1 NZDT} - {2596024800 43200 0 NZST} - {2611144800 46800 1 NZDT} - {2627474400 43200 0 NZST} - {2642594400 46800 1 NZDT} - {2658924000 43200 0 NZST} - {2674044000 46800 1 NZDT} - {2690373600 43200 0 NZST} - {2705493600 46800 1 NZDT} - {2721823200 43200 0 NZST} - {2736943200 46800 1 NZDT} - {2753272800 43200 0 NZST} - {2768997600 46800 1 NZDT} - {2785327200 43200 0 NZST} - {2800447200 46800 1 NZDT} - {2816776800 43200 0 NZST} - {2831896800 46800 1 NZDT} - {2848226400 43200 0 NZST} - {2863346400 46800 1 NZDT} - {2879676000 43200 0 NZST} - {2894796000 46800 1 NZDT} - {2911125600 43200 0 NZST} - {2926245600 46800 1 NZDT} - {2942575200 43200 0 NZST} - {2958300000 46800 1 NZDT} - {2974629600 43200 0 NZST} - {2989749600 46800 1 NZDT} - {3006079200 43200 0 NZST} - {3021199200 46800 1 NZDT} - {3037528800 43200 0 NZST} - {3052648800 46800 1 NZDT} - {3068978400 43200 0 NZST} - {3084098400 46800 1 NZDT} - {3100428000 43200 0 NZST} - {3116152800 46800 1 NZDT} - {3132482400 43200 0 NZST} - {3147602400 46800 1 NZDT} - {3163932000 43200 0 NZST} - {3179052000 46800 1 NZDT} - {3195381600 43200 0 NZST} - {3210501600 46800 1 NZDT} - {3226831200 43200 0 NZST} - {3241951200 46800 1 NZDT} - {3258280800 43200 0 NZST} - {3273400800 46800 1 NZDT} - {3289730400 43200 0 NZST} - {3305455200 46800 1 NZDT} - {3321784800 43200 0 NZST} - {3336904800 46800 1 NZDT} - {3353234400 43200 0 NZST} - {3368354400 46800 1 NZDT} - {3384684000 43200 0 NZST} - {3399804000 46800 1 NZDT} - {3416133600 43200 0 NZST} - {3431253600 46800 1 NZDT} - {3447583200 43200 0 NZST} - {3462703200 46800 1 NZDT} - {3479637600 43200 0 NZST} - {3494757600 46800 1 NZDT} - {3511087200 43200 0 NZST} - {3526207200 46800 1 NZDT} - {3542536800 43200 0 NZST} - {3557656800 46800 1 NZDT} - {3573986400 43200 0 NZST} - {3589106400 46800 1 NZDT} - {3605436000 43200 0 NZST} - {3620556000 46800 1 NZDT} - {3636885600 43200 0 NZST} - {3652610400 46800 1 NZDT} - {3668940000 43200 0 NZST} - {3684060000 46800 1 NZDT} - {3700389600 43200 0 NZST} - {3715509600 46800 1 NZDT} - {3731839200 43200 0 NZST} - {3746959200 46800 1 NZDT} - {3763288800 43200 0 NZST} - {3778408800 46800 1 NZDT} - {3794738400 43200 0 NZST} - {3809858400 46800 1 NZDT} - {3826188000 43200 0 NZST} - {3841912800 46800 1 NZDT} - {3858242400 43200 0 NZST} - {3873362400 46800 1 NZDT} - {3889692000 43200 0 NZST} - {3904812000 46800 1 NZDT} - {3921141600 43200 0 NZST} - {3936261600 46800 1 NZDT} - {3952591200 43200 0 NZST} - {3967711200 46800 1 NZDT} - {3984040800 43200 0 NZST} - {3999765600 46800 1 NZDT} - {4016095200 43200 0 NZST} - {4031215200 46800 1 NZDT} - {4047544800 43200 0 NZST} - {4062664800 46800 1 NZDT} - {4078994400 43200 0 NZST} - {4094114400 46800 1 NZDT} +if {![info exists TZData(Pacific/Auckland)]} { + LoadTimeZoneFile Pacific/Auckland } +set TZData(:Antarctica/McMurdo) $TZData(:Pacific/Auckland) diff --git a/library/tzdata/Antarctica/South_Pole b/library/tzdata/Antarctica/South_Pole index 34d0db1..544bde4 100644 --- a/library/tzdata/Antarctica/South_Pole +++ b/library/tzdata/Antarctica/South_Pole @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit -if {![info exists TZData(Antarctica/McMurdo)]} { - LoadTimeZoneFile Antarctica/McMurdo +if {![info exists TZData(Pacific/Auckland)]} { + LoadTimeZoneFile Pacific/Auckland } -set TZData(:Antarctica/South_Pole) $TZData(:Antarctica/McMurdo) +set TZData(:Antarctica/South_Pole) $TZData(:Pacific/Auckland) diff --git a/library/tzdata/Asia/Amman b/library/tzdata/Asia/Amman index 33f0ba7..d5e8616 100644 --- a/library/tzdata/Asia/Amman +++ b/library/tzdata/Asia/Amman @@ -70,178 +70,5 @@ set TZData(:Asia/Amman) { {1301608800 10800 1 EEST} {1319752800 7200 0 EET} {1333058400 10800 1 EEST} - {1364504400 10800 1 EEST} - {1382652000 7200 0 EET} - {1395957600 10800 1 EEST} - {1414706400 7200 0 EET} - {1427407200 10800 1 EEST} - {1446156000 7200 0 EET} - {1459461600 10800 1 EEST} - {1477605600 7200 0 EET} - {1490911200 10800 1 EEST} - {1509055200 7200 0 EET} - {1522360800 10800 1 EEST} - {1540504800 7200 0 EET} - {1553810400 10800 1 EEST} - {1571954400 7200 0 EET} - {1585260000 10800 1 EEST} - {1604008800 7200 0 EET} - {1616709600 10800 1 EEST} - {1635458400 7200 0 EET} - {1648764000 10800 1 EEST} - {1666908000 7200 0 EET} - {1680213600 10800 1 EEST} - {1698357600 7200 0 EET} - {1711663200 10800 1 EEST} - {1729807200 7200 0 EET} - {1743112800 10800 1 EEST} - {1761861600 7200 0 EET} - {1774562400 10800 1 EEST} - {1793311200 7200 0 EET} - {1806012000 10800 1 EEST} - {1824760800 7200 0 EET} - {1838066400 10800 1 EEST} - {1856210400 7200 0 EET} - {1869516000 10800 1 EEST} - {1887660000 7200 0 EET} - {1900965600 10800 1 EEST} - {1919109600 7200 0 EET} - {1932415200 10800 1 EEST} - {1951164000 7200 0 EET} - {1963864800 10800 1 EEST} - {1982613600 7200 0 EET} - {1995919200 10800 1 EEST} - {2014063200 7200 0 EET} - {2027368800 10800 1 EEST} - {2045512800 7200 0 EET} - {2058818400 10800 1 EEST} - {2076962400 7200 0 EET} - {2090268000 10800 1 EEST} - {2109016800 7200 0 EET} - {2121717600 10800 1 EEST} - {2140466400 7200 0 EET} - {2153167200 10800 1 EEST} - {2171916000 7200 0 EET} - {2185221600 10800 1 EEST} - {2203365600 7200 0 EET} - {2216671200 10800 1 EEST} - {2234815200 7200 0 EET} - {2248120800 10800 1 EEST} - {2266264800 7200 0 EET} - {2279570400 10800 1 EEST} - {2298319200 7200 0 EET} - {2311020000 10800 1 EEST} - {2329768800 7200 0 EET} - {2343074400 10800 1 EEST} - {2361218400 7200 0 EET} - {2374524000 10800 1 EEST} - {2392668000 7200 0 EET} - {2405973600 10800 1 EEST} - {2424117600 7200 0 EET} - {2437423200 10800 1 EEST} - {2455567200 7200 0 EET} - {2468872800 10800 1 EEST} - {2487621600 7200 0 EET} - {2500322400 10800 1 EEST} - {2519071200 7200 0 EET} - {2532376800 10800 1 EEST} - {2550520800 7200 0 EET} - {2563826400 10800 1 EEST} - {2581970400 7200 0 EET} - {2595276000 10800 1 EEST} - {2613420000 7200 0 EET} - {2626725600 10800 1 EEST} - {2645474400 7200 0 EET} - {2658175200 10800 1 EEST} - {2676924000 7200 0 EET} - {2689624800 10800 1 EEST} - {2708373600 7200 0 EET} - {2721679200 10800 1 EEST} - {2739823200 7200 0 EET} - {2753128800 10800 1 EEST} - {2771272800 7200 0 EET} - {2784578400 10800 1 EEST} - {2802722400 7200 0 EET} - {2816028000 10800 1 EEST} - {2834776800 7200 0 EET} - {2847477600 10800 1 EEST} - {2866226400 7200 0 EET} - {2879532000 10800 1 EEST} - {2897676000 7200 0 EET} - {2910981600 10800 1 EEST} - {2929125600 7200 0 EET} - {2942431200 10800 1 EEST} - {2960575200 7200 0 EET} - {2973880800 10800 1 EEST} - {2992629600 7200 0 EET} - {3005330400 10800 1 EEST} - {3024079200 7200 0 EET} - {3036780000 10800 1 EEST} - {3055528800 7200 0 EET} - {3068834400 10800 1 EEST} - {3086978400 7200 0 EET} - {3100284000 10800 1 EEST} - {3118428000 7200 0 EET} - {3131733600 10800 1 EEST} - {3149877600 7200 0 EET} - {3163183200 10800 1 EEST} - {3181932000 7200 0 EET} - {3194632800 10800 1 EEST} - {3213381600 7200 0 EET} - {3226687200 10800 1 EEST} - {3244831200 7200 0 EET} - {3258136800 10800 1 EEST} - {3276280800 7200 0 EET} - {3289586400 10800 1 EEST} - {3307730400 7200 0 EET} - {3321036000 10800 1 EEST} - {3339180000 7200 0 EET} - {3352485600 10800 1 EEST} - {3371234400 7200 0 EET} - {3383935200 10800 1 EEST} - {3402684000 7200 0 EET} - {3415989600 10800 1 EEST} - {3434133600 7200 0 EET} - {3447439200 10800 1 EEST} - {3465583200 7200 0 EET} - {3478888800 10800 1 EEST} - {3497032800 7200 0 EET} - {3510338400 10800 1 EEST} - {3529087200 7200 0 EET} - {3541788000 10800 1 EEST} - {3560536800 7200 0 EET} - {3573237600 10800 1 EEST} - {3591986400 7200 0 EET} - {3605292000 10800 1 EEST} - {3623436000 7200 0 EET} - {3636741600 10800 1 EEST} - {3654885600 7200 0 EET} - {3668191200 10800 1 EEST} - {3686335200 7200 0 EET} - {3699640800 10800 1 EEST} - {3718389600 7200 0 EET} - {3731090400 10800 1 EEST} - {3749839200 7200 0 EET} - {3763144800 10800 1 EEST} - {3781288800 7200 0 EET} - {3794594400 10800 1 EEST} - {3812738400 7200 0 EET} - {3826044000 10800 1 EEST} - {3844188000 7200 0 EET} - {3857493600 10800 1 EEST} - {3876242400 7200 0 EET} - {3888943200 10800 1 EEST} - {3907692000 7200 0 EET} - {3920392800 10800 1 EEST} - {3939141600 7200 0 EET} - {3952447200 10800 1 EEST} - {3970591200 7200 0 EET} - {3983896800 10800 1 EEST} - {4002040800 7200 0 EET} - {4015346400 10800 1 EEST} - {4033490400 7200 0 EET} - {4046796000 10800 1 EEST} - {4065544800 7200 0 EET} - {4078245600 10800 1 EEST} - {4096994400 7200 0 EET} + {1351202400 10800 0 AST} } diff --git a/library/tzdata/Asia/Dili b/library/tzdata/Asia/Dili index 36910fd..f783557 100644 --- a/library/tzdata/Asia/Dili +++ b/library/tzdata/Asia/Dili @@ -5,6 +5,6 @@ set TZData(:Asia/Dili) { {-1830414140 28800 0 TLT} {-879152400 32400 0 JST} {-766054800 32400 0 TLT} - {199897200 28800 0 CIT} + {199897200 28800 0 WITA} {969120000 32400 0 TLT} } diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index a0636e2..7d62a96 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -102,177 +102,177 @@ set TZData(:Asia/Gaza) { {1333058400 10800 1 EEST} {1348178400 7200 0 EET} {1364508000 10800 1 EEST} - {1380232800 7200 0 EET} + {1380229200 7200 0 EET} {1395957600 10800 1 EEST} - {1411682400 7200 0 EET} + {1411678800 7200 0 EET} {1427407200 10800 1 EEST} - {1443132000 7200 0 EET} + {1443128400 7200 0 EET} {1459461600 10800 1 EEST} - {1474581600 7200 0 EET} + {1474578000 7200 0 EET} {1490911200 10800 1 EEST} - {1506031200 7200 0 EET} + {1506027600 7200 0 EET} {1522360800 10800 1 EEST} - {1537480800 7200 0 EET} + {1537477200 7200 0 EET} {1553810400 10800 1 EEST} - {1569535200 7200 0 EET} + {1569531600 7200 0 EET} {1585260000 10800 1 EEST} - {1600984800 7200 0 EET} + {1600981200 7200 0 EET} {1616709600 10800 1 EEST} - {1632434400 7200 0 EET} + {1632430800 7200 0 EET} {1648764000 10800 1 EEST} - {1663884000 7200 0 EET} + {1663880400 7200 0 EET} {1680213600 10800 1 EEST} - {1695333600 7200 0 EET} + {1695330000 7200 0 EET} {1711663200 10800 1 EEST} - {1727388000 7200 0 EET} + {1727384400 7200 0 EET} {1743112800 10800 1 EEST} - {1758837600 7200 0 EET} + {1758834000 7200 0 EET} {1774562400 10800 1 EEST} - {1790287200 7200 0 EET} + {1790283600 7200 0 EET} {1806012000 10800 1 EEST} - {1821736800 7200 0 EET} + {1821733200 7200 0 EET} {1838066400 10800 1 EEST} - {1853186400 7200 0 EET} + {1853182800 7200 0 EET} {1869516000 10800 1 EEST} - {1884636000 7200 0 EET} + {1884632400 7200 0 EET} {1900965600 10800 1 EEST} - {1916690400 7200 0 EET} + {1916686800 7200 0 EET} {1932415200 10800 1 EEST} - {1948140000 7200 0 EET} + {1948136400 7200 0 EET} {1963864800 10800 1 EEST} - {1979589600 7200 0 EET} + {1979586000 7200 0 EET} {1995919200 10800 1 EEST} - {2011039200 7200 0 EET} + {2011035600 7200 0 EET} {2027368800 10800 1 EEST} - {2042488800 7200 0 EET} + {2042485200 7200 0 EET} {2058818400 10800 1 EEST} - {2073938400 7200 0 EET} + {2073934800 7200 0 EET} {2090268000 10800 1 EEST} - {2105992800 7200 0 EET} + {2105989200 7200 0 EET} {2121717600 10800 1 EEST} - {2137442400 7200 0 EET} + {2137438800 7200 0 EET} {2153167200 10800 1 EEST} - {2168892000 7200 0 EET} + {2168888400 7200 0 EET} {2185221600 10800 1 EEST} - {2200341600 7200 0 EET} + {2200338000 7200 0 EET} {2216671200 10800 1 EEST} - {2231791200 7200 0 EET} + {2231787600 7200 0 EET} {2248120800 10800 1 EEST} - {2263845600 7200 0 EET} + {2263842000 7200 0 EET} {2279570400 10800 1 EEST} - {2295295200 7200 0 EET} + {2295291600 7200 0 EET} {2311020000 10800 1 EEST} - {2326744800 7200 0 EET} + {2326741200 7200 0 EET} {2343074400 10800 1 EEST} - {2358194400 7200 0 EET} + {2358190800 7200 0 EET} {2374524000 10800 1 EEST} - {2389644000 7200 0 EET} + {2389640400 7200 0 EET} {2405973600 10800 1 EEST} - {2421093600 7200 0 EET} + {2421090000 7200 0 EET} {2437423200 10800 1 EEST} - {2453148000 7200 0 EET} + {2453144400 7200 0 EET} {2468872800 10800 1 EEST} - {2484597600 7200 0 EET} + {2484594000 7200 0 EET} {2500322400 10800 1 EEST} - {2516047200 7200 0 EET} + {2516043600 7200 0 EET} {2532376800 10800 1 EEST} - {2547496800 7200 0 EET} + {2547493200 7200 0 EET} {2563826400 10800 1 EEST} - {2578946400 7200 0 EET} + {2578942800 7200 0 EET} {2595276000 10800 1 EEST} - {2611000800 7200 0 EET} + {2610997200 7200 0 EET} {2626725600 10800 1 EEST} - {2642450400 7200 0 EET} + {2642446800 7200 0 EET} {2658175200 10800 1 EEST} - {2673900000 7200 0 EET} + {2673896400 7200 0 EET} {2689624800 10800 1 EEST} - {2705349600 7200 0 EET} + {2705346000 7200 0 EET} {2721679200 10800 1 EEST} - {2736799200 7200 0 EET} + {2736795600 7200 0 EET} {2753128800 10800 1 EEST} - {2768248800 7200 0 EET} + {2768245200 7200 0 EET} {2784578400 10800 1 EEST} - {2800303200 7200 0 EET} + {2800299600 7200 0 EET} {2816028000 10800 1 EEST} - {2831752800 7200 0 EET} + {2831749200 7200 0 EET} {2847477600 10800 1 EEST} - {2863202400 7200 0 EET} + {2863198800 7200 0 EET} {2879532000 10800 1 EEST} - {2894652000 7200 0 EET} + {2894648400 7200 0 EET} {2910981600 10800 1 EEST} - {2926101600 7200 0 EET} + {2926098000 7200 0 EET} {2942431200 10800 1 EEST} - {2957551200 7200 0 EET} + {2957547600 7200 0 EET} {2973880800 10800 1 EEST} - {2989605600 7200 0 EET} + {2989602000 7200 0 EET} {3005330400 10800 1 EEST} - {3021055200 7200 0 EET} + {3021051600 7200 0 EET} {3036780000 10800 1 EEST} - {3052504800 7200 0 EET} + {3052501200 7200 0 EET} {3068834400 10800 1 EEST} - {3083954400 7200 0 EET} + {3083950800 7200 0 EET} {3100284000 10800 1 EEST} - {3115404000 7200 0 EET} + {3115400400 7200 0 EET} {3131733600 10800 1 EEST} - {3147458400 7200 0 EET} + {3147454800 7200 0 EET} {3163183200 10800 1 EEST} - {3178908000 7200 0 EET} + {3178904400 7200 0 EET} {3194632800 10800 1 EEST} - {3210357600 7200 0 EET} + {3210354000 7200 0 EET} {3226687200 10800 1 EEST} - {3241807200 7200 0 EET} + {3241803600 7200 0 EET} {3258136800 10800 1 EEST} - {3273256800 7200 0 EET} + {3273253200 7200 0 EET} {3289586400 10800 1 EEST} - {3304706400 7200 0 EET} + {3304702800 7200 0 EET} {3321036000 10800 1 EEST} - {3336760800 7200 0 EET} + {3336757200 7200 0 EET} {3352485600 10800 1 EEST} - {3368210400 7200 0 EET} + {3368206800 7200 0 EET} {3383935200 10800 1 EEST} - {3399660000 7200 0 EET} + {3399656400 7200 0 EET} {3415989600 10800 1 EEST} - {3431109600 7200 0 EET} + {3431106000 7200 0 EET} {3447439200 10800 1 EEST} - {3462559200 7200 0 EET} + {3462555600 7200 0 EET} {3478888800 10800 1 EEST} - {3494613600 7200 0 EET} + {3494610000 7200 0 EET} {3510338400 10800 1 EEST} - {3526063200 7200 0 EET} + {3526059600 7200 0 EET} {3541788000 10800 1 EEST} - {3557512800 7200 0 EET} + {3557509200 7200 0 EET} {3573237600 10800 1 EEST} - {3588962400 7200 0 EET} + {3588958800 7200 0 EET} {3605292000 10800 1 EEST} - {3620412000 7200 0 EET} + {3620408400 7200 0 EET} {3636741600 10800 1 EEST} - {3651861600 7200 0 EET} + {3651858000 7200 0 EET} {3668191200 10800 1 EEST} - {3683916000 7200 0 EET} + {3683912400 7200 0 EET} {3699640800 10800 1 EEST} - {3715365600 7200 0 EET} + {3715362000 7200 0 EET} {3731090400 10800 1 EEST} - {3746815200 7200 0 EET} + {3746811600 7200 0 EET} {3763144800 10800 1 EEST} - {3778264800 7200 0 EET} + {3778261200 7200 0 EET} {3794594400 10800 1 EEST} - {3809714400 7200 0 EET} + {3809710800 7200 0 EET} {3826044000 10800 1 EEST} - {3841164000 7200 0 EET} + {3841160400 7200 0 EET} {3857493600 10800 1 EEST} - {3873218400 7200 0 EET} + {3873214800 7200 0 EET} {3888943200 10800 1 EEST} - {3904668000 7200 0 EET} + {3904664400 7200 0 EET} {3920392800 10800 1 EEST} - {3936117600 7200 0 EET} + {3936114000 7200 0 EET} {3952447200 10800 1 EEST} - {3967567200 7200 0 EET} + {3967563600 7200 0 EET} {3983896800 10800 1 EEST} - {3999016800 7200 0 EET} + {3999013200 7200 0 EET} {4015346400 10800 1 EEST} - {4031071200 7200 0 EET} + {4031067600 7200 0 EET} {4046796000 10800 1 EEST} - {4062520800 7200 0 EET} + {4062517200 7200 0 EET} {4078245600 10800 1 EEST} - {4093970400 7200 0 EET} + {4093966800 7200 0 EET} } diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index a8a9019..1333d5a 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -101,177 +101,177 @@ set TZData(:Asia/Hebron) { {1333058400 10800 1 EEST} {1348178400 7200 0 EET} {1364508000 10800 1 EEST} - {1380232800 7200 0 EET} + {1380229200 7200 0 EET} {1395957600 10800 1 EEST} - {1411682400 7200 0 EET} + {1411678800 7200 0 EET} {1427407200 10800 1 EEST} - {1443132000 7200 0 EET} + {1443128400 7200 0 EET} {1459461600 10800 1 EEST} - {1474581600 7200 0 EET} + {1474578000 7200 0 EET} {1490911200 10800 1 EEST} - {1506031200 7200 0 EET} + {1506027600 7200 0 EET} {1522360800 10800 1 EEST} - {1537480800 7200 0 EET} + {1537477200 7200 0 EET} {1553810400 10800 1 EEST} - {1569535200 7200 0 EET} + {1569531600 7200 0 EET} {1585260000 10800 1 EEST} - {1600984800 7200 0 EET} + {1600981200 7200 0 EET} {1616709600 10800 1 EEST} - {1632434400 7200 0 EET} + {1632430800 7200 0 EET} {1648764000 10800 1 EEST} - {1663884000 7200 0 EET} + {1663880400 7200 0 EET} {1680213600 10800 1 EEST} - {1695333600 7200 0 EET} + {1695330000 7200 0 EET} {1711663200 10800 1 EEST} - {1727388000 7200 0 EET} + {1727384400 7200 0 EET} {1743112800 10800 1 EEST} - {1758837600 7200 0 EET} + {1758834000 7200 0 EET} {1774562400 10800 1 EEST} - {1790287200 7200 0 EET} + {1790283600 7200 0 EET} {1806012000 10800 1 EEST} - {1821736800 7200 0 EET} + {1821733200 7200 0 EET} {1838066400 10800 1 EEST} - {1853186400 7200 0 EET} + {1853182800 7200 0 EET} {1869516000 10800 1 EEST} - {1884636000 7200 0 EET} + {1884632400 7200 0 EET} {1900965600 10800 1 EEST} - {1916690400 7200 0 EET} + {1916686800 7200 0 EET} {1932415200 10800 1 EEST} - {1948140000 7200 0 EET} + {1948136400 7200 0 EET} {1963864800 10800 1 EEST} - {1979589600 7200 0 EET} + {1979586000 7200 0 EET} {1995919200 10800 1 EEST} - {2011039200 7200 0 EET} + {2011035600 7200 0 EET} {2027368800 10800 1 EEST} - {2042488800 7200 0 EET} + {2042485200 7200 0 EET} {2058818400 10800 1 EEST} - {2073938400 7200 0 EET} + {2073934800 7200 0 EET} {2090268000 10800 1 EEST} - {2105992800 7200 0 EET} + {2105989200 7200 0 EET} {2121717600 10800 1 EEST} - {2137442400 7200 0 EET} + {2137438800 7200 0 EET} {2153167200 10800 1 EEST} - {2168892000 7200 0 EET} + {2168888400 7200 0 EET} {2185221600 10800 1 EEST} - {2200341600 7200 0 EET} + {2200338000 7200 0 EET} {2216671200 10800 1 EEST} - {2231791200 7200 0 EET} + {2231787600 7200 0 EET} {2248120800 10800 1 EEST} - {2263845600 7200 0 EET} + {2263842000 7200 0 EET} {2279570400 10800 1 EEST} - {2295295200 7200 0 EET} + {2295291600 7200 0 EET} {2311020000 10800 1 EEST} - {2326744800 7200 0 EET} + {2326741200 7200 0 EET} {2343074400 10800 1 EEST} - {2358194400 7200 0 EET} + {2358190800 7200 0 EET} {2374524000 10800 1 EEST} - {2389644000 7200 0 EET} + {2389640400 7200 0 EET} {2405973600 10800 1 EEST} - {2421093600 7200 0 EET} + {2421090000 7200 0 EET} {2437423200 10800 1 EEST} - {2453148000 7200 0 EET} + {2453144400 7200 0 EET} {2468872800 10800 1 EEST} - {2484597600 7200 0 EET} + {2484594000 7200 0 EET} {2500322400 10800 1 EEST} - {2516047200 7200 0 EET} + {2516043600 7200 0 EET} {2532376800 10800 1 EEST} - {2547496800 7200 0 EET} + {2547493200 7200 0 EET} {2563826400 10800 1 EEST} - {2578946400 7200 0 EET} + {2578942800 7200 0 EET} {2595276000 10800 1 EEST} - {2611000800 7200 0 EET} + {2610997200 7200 0 EET} {2626725600 10800 1 EEST} - {2642450400 7200 0 EET} + {2642446800 7200 0 EET} {2658175200 10800 1 EEST} - {2673900000 7200 0 EET} + {2673896400 7200 0 EET} {2689624800 10800 1 EEST} - {2705349600 7200 0 EET} + {2705346000 7200 0 EET} {2721679200 10800 1 EEST} - {2736799200 7200 0 EET} + {2736795600 7200 0 EET} {2753128800 10800 1 EEST} - {2768248800 7200 0 EET} + {2768245200 7200 0 EET} {2784578400 10800 1 EEST} - {2800303200 7200 0 EET} + {2800299600 7200 0 EET} {2816028000 10800 1 EEST} - {2831752800 7200 0 EET} + {2831749200 7200 0 EET} {2847477600 10800 1 EEST} - {2863202400 7200 0 EET} + {2863198800 7200 0 EET} {2879532000 10800 1 EEST} - {2894652000 7200 0 EET} + {2894648400 7200 0 EET} {2910981600 10800 1 EEST} - {2926101600 7200 0 EET} + {2926098000 7200 0 EET} {2942431200 10800 1 EEST} - {2957551200 7200 0 EET} + {2957547600 7200 0 EET} {2973880800 10800 1 EEST} - {2989605600 7200 0 EET} + {2989602000 7200 0 EET} {3005330400 10800 1 EEST} - {3021055200 7200 0 EET} + {3021051600 7200 0 EET} {3036780000 10800 1 EEST} - {3052504800 7200 0 EET} + {3052501200 7200 0 EET} {3068834400 10800 1 EEST} - {3083954400 7200 0 EET} + {3083950800 7200 0 EET} {3100284000 10800 1 EEST} - {3115404000 7200 0 EET} + {3115400400 7200 0 EET} {3131733600 10800 1 EEST} - {3147458400 7200 0 EET} + {3147454800 7200 0 EET} {3163183200 10800 1 EEST} - {3178908000 7200 0 EET} + {3178904400 7200 0 EET} {3194632800 10800 1 EEST} - {3210357600 7200 0 EET} + {3210354000 7200 0 EET} {3226687200 10800 1 EEST} - {3241807200 7200 0 EET} + {3241803600 7200 0 EET} {3258136800 10800 1 EEST} - {3273256800 7200 0 EET} + {3273253200 7200 0 EET} {3289586400 10800 1 EEST} - {3304706400 7200 0 EET} + {3304702800 7200 0 EET} {3321036000 10800 1 EEST} - {3336760800 7200 0 EET} + {3336757200 7200 0 EET} {3352485600 10800 1 EEST} - {3368210400 7200 0 EET} + {3368206800 7200 0 EET} {3383935200 10800 1 EEST} - {3399660000 7200 0 EET} + {3399656400 7200 0 EET} {3415989600 10800 1 EEST} - {3431109600 7200 0 EET} + {3431106000 7200 0 EET} {3447439200 10800 1 EEST} - {3462559200 7200 0 EET} + {3462555600 7200 0 EET} {3478888800 10800 1 EEST} - {3494613600 7200 0 EET} + {3494610000 7200 0 EET} {3510338400 10800 1 EEST} - {3526063200 7200 0 EET} + {3526059600 7200 0 EET} {3541788000 10800 1 EEST} - {3557512800 7200 0 EET} + {3557509200 7200 0 EET} {3573237600 10800 1 EEST} - {3588962400 7200 0 EET} + {3588958800 7200 0 EET} {3605292000 10800 1 EEST} - {3620412000 7200 0 EET} + {3620408400 7200 0 EET} {3636741600 10800 1 EEST} - {3651861600 7200 0 EET} + {3651858000 7200 0 EET} {3668191200 10800 1 EEST} - {3683916000 7200 0 EET} + {3683912400 7200 0 EET} {3699640800 10800 1 EEST} - {3715365600 7200 0 EET} + {3715362000 7200 0 EET} {3731090400 10800 1 EEST} - {3746815200 7200 0 EET} + {3746811600 7200 0 EET} {3763144800 10800 1 EEST} - {3778264800 7200 0 EET} + {3778261200 7200 0 EET} {3794594400 10800 1 EEST} - {3809714400 7200 0 EET} + {3809710800 7200 0 EET} {3826044000 10800 1 EEST} - {3841164000 7200 0 EET} + {3841160400 7200 0 EET} {3857493600 10800 1 EEST} - {3873218400 7200 0 EET} + {3873214800 7200 0 EET} {3888943200 10800 1 EEST} - {3904668000 7200 0 EET} + {3904664400 7200 0 EET} {3920392800 10800 1 EEST} - {3936117600 7200 0 EET} + {3936114000 7200 0 EET} {3952447200 10800 1 EEST} - {3967567200 7200 0 EET} + {3967563600 7200 0 EET} {3983896800 10800 1 EEST} - {3999016800 7200 0 EET} + {3999013200 7200 0 EET} {4015346400 10800 1 EEST} - {4031071200 7200 0 EET} + {4031067600 7200 0 EET} {4046796000 10800 1 EEST} - {4062520800 7200 0 EET} + {4062517200 7200 0 EET} {4078245600 10800 1 EEST} - {4093970400 7200 0 EET} + {4093966800 7200 0 EET} } diff --git a/library/tzdata/Asia/Jakarta b/library/tzdata/Asia/Jakarta index 27033e8..75cd659 100644 --- a/library/tzdata/Asia/Jakarta +++ b/library/tzdata/Asia/Jakarta @@ -2,12 +2,12 @@ set TZData(:Asia/Jakarta) { {-9223372036854775808 25632 0 LMT} - {-3231299232 25632 0 JMT} + {-3231299232 25632 0 BMT} {-1451719200 26400 0 JAVT} - {-1172906400 27000 0 WIT} + {-1172906400 27000 0 WIB} {-876641400 32400 0 JST} - {-766054800 27000 0 WIT} - {-683883000 28800 0 WIT} - {-620812800 27000 0 WIT} - {-189415800 25200 0 WIT} + {-766054800 27000 0 WIB} + {-683883000 28800 0 WIB} + {-620812800 27000 0 WIB} + {-189415800 25200 0 WIB} } diff --git a/library/tzdata/Asia/Jayapura b/library/tzdata/Asia/Jayapura index 893da8b..a71228f 100644 --- a/library/tzdata/Asia/Jayapura +++ b/library/tzdata/Asia/Jayapura @@ -2,7 +2,7 @@ set TZData(:Asia/Jayapura) { {-9223372036854775808 33768 0 LMT} - {-1172913768 32400 0 EIT} + {-1172913768 32400 0 WIT} {-799491600 34200 0 CST} - {-189423000 32400 0 EIT} + {-189423000 32400 0 WIT} } diff --git a/library/tzdata/Asia/Makassar b/library/tzdata/Asia/Makassar index aa604b4..be947f3 100644 --- a/library/tzdata/Asia/Makassar +++ b/library/tzdata/Asia/Makassar @@ -3,7 +3,7 @@ set TZData(:Asia/Makassar) { {-9223372036854775808 28656 0 LMT} {-1577951856 28656 0 MMT} - {-1172908656 28800 0 CIT} + {-1172908656 28800 0 WITA} {-880272000 32400 0 JST} - {-766054800 28800 0 CIT} + {-766054800 28800 0 WITA} } diff --git a/library/tzdata/Asia/Pontianak b/library/tzdata/Asia/Pontianak index f3567dd..728b552 100644 --- a/library/tzdata/Asia/Pontianak +++ b/library/tzdata/Asia/Pontianak @@ -3,11 +3,11 @@ set TZData(:Asia/Pontianak) { {-9223372036854775808 26240 0 LMT} {-1946186240 26240 0 PMT} - {-1172906240 27000 0 WIT} + {-1172906240 27000 0 WIB} {-881220600 32400 0 JST} - {-766054800 27000 0 WIT} - {-683883000 28800 0 WIT} - {-620812800 27000 0 WIT} - {-189415800 28800 0 CIT} - {567964800 25200 0 WIT} + {-766054800 27000 0 WIB} + {-683883000 28800 0 WIB} + {-620812800 27000 0 WIB} + {-189415800 28800 0 WITA} + {567964800 25200 0 WIB} } diff --git a/library/tzdata/Europe/Vaduz b/library/tzdata/Europe/Vaduz index 3118331..095e018 100644 --- a/library/tzdata/Europe/Vaduz +++ b/library/tzdata/Europe/Vaduz @@ -1,245 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Europe/Vaduz) { - {-9223372036854775808 2284 0 LMT} - {-2385247084 3600 0 CET} - {347151600 3600 0 CET} - {354675600 7200 1 CEST} - {370400400 3600 0 CET} - {386125200 7200 1 CEST} - {401850000 3600 0 CET} - {417574800 7200 1 CEST} - {433299600 3600 0 CET} - {449024400 7200 1 CEST} - {465354000 3600 0 CET} - {481078800 7200 1 CEST} - {496803600 3600 0 CET} - {512528400 7200 1 CEST} - {528253200 3600 0 CET} - {543978000 7200 1 CEST} - {559702800 3600 0 CET} - {575427600 7200 1 CEST} - {591152400 3600 0 CET} - {606877200 7200 1 CEST} - {622602000 3600 0 CET} - {638326800 7200 1 CEST} - {654656400 3600 0 CET} - {670381200 7200 1 CEST} - {686106000 3600 0 CET} - {701830800 7200 1 CEST} - {717555600 3600 0 CET} - {733280400 7200 1 CEST} - {749005200 3600 0 CET} - {764730000 7200 1 CEST} - {780454800 3600 0 CET} - {796179600 7200 1 CEST} - {811904400 3600 0 CET} - {828234000 7200 1 CEST} - {846378000 3600 0 CET} - {859683600 7200 1 CEST} - {877827600 3600 0 CET} - {891133200 7200 1 CEST} - {909277200 3600 0 CET} - {922582800 7200 1 CEST} - {941331600 3600 0 CET} - {954032400 7200 1 CEST} - {972781200 3600 0 CET} - {985482000 7200 1 CEST} - {1004230800 3600 0 CET} - {1017536400 7200 1 CEST} - {1035680400 3600 0 CET} - {1048986000 7200 1 CEST} - {1067130000 3600 0 CET} - {1080435600 7200 1 CEST} - {1099184400 3600 0 CET} - {1111885200 7200 1 CEST} - {1130634000 3600 0 CET} - {1143334800 7200 1 CEST} - {1162083600 3600 0 CET} - {1174784400 7200 1 CEST} - {1193533200 3600 0 CET} - {1206838800 7200 1 CEST} - {1224982800 3600 0 CET} - {1238288400 7200 1 CEST} - {1256432400 3600 0 CET} - {1269738000 7200 1 CEST} - {1288486800 3600 0 CET} - {1301187600 7200 1 CEST} - {1319936400 3600 0 CET} - {1332637200 7200 1 CEST} - {1351386000 3600 0 CET} - {1364691600 7200 1 CEST} - {1382835600 3600 0 CET} - {1396141200 7200 1 CEST} - {1414285200 3600 0 CET} - {1427590800 7200 1 CEST} - {1445734800 3600 0 CET} - {1459040400 7200 1 CEST} - {1477789200 3600 0 CET} - {1490490000 7200 1 CEST} - {1509238800 3600 0 CET} - {1521939600 7200 1 CEST} - {1540688400 3600 0 CET} - {1553994000 7200 1 CEST} - {1572138000 3600 0 CET} - {1585443600 7200 1 CEST} - {1603587600 3600 0 CET} - {1616893200 7200 1 CEST} - {1635642000 3600 0 CET} - {1648342800 7200 1 CEST} - {1667091600 3600 0 CET} - {1679792400 7200 1 CEST} - {1698541200 3600 0 CET} - {1711846800 7200 1 CEST} - {1729990800 3600 0 CET} - {1743296400 7200 1 CEST} - {1761440400 3600 0 CET} - {1774746000 7200 1 CEST} - {1792890000 3600 0 CET} - {1806195600 7200 1 CEST} - {1824944400 3600 0 CET} - {1837645200 7200 1 CEST} - {1856394000 3600 0 CET} - {1869094800 7200 1 CEST} - {1887843600 3600 0 CET} - {1901149200 7200 1 CEST} - {1919293200 3600 0 CET} - {1932598800 7200 1 CEST} - {1950742800 3600 0 CET} - {1964048400 7200 1 CEST} - {1982797200 3600 0 CET} - {1995498000 7200 1 CEST} - {2014246800 3600 0 CET} - {2026947600 7200 1 CEST} - {2045696400 3600 0 CET} - {2058397200 7200 1 CEST} - {2077146000 3600 0 CET} - {2090451600 7200 1 CEST} - {2108595600 3600 0 CET} - {2121901200 7200 1 CEST} - {2140045200 3600 0 CET} - {2153350800 7200 1 CEST} - {2172099600 3600 0 CET} - {2184800400 7200 1 CEST} - {2203549200 3600 0 CET} - {2216250000 7200 1 CEST} - {2234998800 3600 0 CET} - {2248304400 7200 1 CEST} - {2266448400 3600 0 CET} - {2279754000 7200 1 CEST} - {2297898000 3600 0 CET} - {2311203600 7200 1 CEST} - {2329347600 3600 0 CET} - {2342653200 7200 1 CEST} - {2361402000 3600 0 CET} - {2374102800 7200 1 CEST} - {2392851600 3600 0 CET} - {2405552400 7200 1 CEST} - {2424301200 3600 0 CET} - {2437606800 7200 1 CEST} - {2455750800 3600 0 CET} - {2469056400 7200 1 CEST} - {2487200400 3600 0 CET} - {2500506000 7200 1 CEST} - {2519254800 3600 0 CET} - {2531955600 7200 1 CEST} - {2550704400 3600 0 CET} - {2563405200 7200 1 CEST} - {2582154000 3600 0 CET} - {2595459600 7200 1 CEST} - {2613603600 3600 0 CET} - {2626909200 7200 1 CEST} - {2645053200 3600 0 CET} - {2658358800 7200 1 CEST} - {2676502800 3600 0 CET} - {2689808400 7200 1 CEST} - {2708557200 3600 0 CET} - {2721258000 7200 1 CEST} - {2740006800 3600 0 CET} - {2752707600 7200 1 CEST} - {2771456400 3600 0 CET} - {2784762000 7200 1 CEST} - {2802906000 3600 0 CET} - {2816211600 7200 1 CEST} - {2834355600 3600 0 CET} - {2847661200 7200 1 CEST} - {2866410000 3600 0 CET} - {2879110800 7200 1 CEST} - {2897859600 3600 0 CET} - {2910560400 7200 1 CEST} - {2929309200 3600 0 CET} - {2942010000 7200 1 CEST} - {2960758800 3600 0 CET} - {2974064400 7200 1 CEST} - {2992208400 3600 0 CET} - {3005514000 7200 1 CEST} - {3023658000 3600 0 CET} - {3036963600 7200 1 CEST} - {3055712400 3600 0 CET} - {3068413200 7200 1 CEST} - {3087162000 3600 0 CET} - {3099862800 7200 1 CEST} - {3118611600 3600 0 CET} - {3131917200 7200 1 CEST} - {3150061200 3600 0 CET} - {3163366800 7200 1 CEST} - {3181510800 3600 0 CET} - {3194816400 7200 1 CEST} - {3212960400 3600 0 CET} - {3226266000 7200 1 CEST} - {3245014800 3600 0 CET} - {3257715600 7200 1 CEST} - {3276464400 3600 0 CET} - {3289165200 7200 1 CEST} - {3307914000 3600 0 CET} - {3321219600 7200 1 CEST} - {3339363600 3600 0 CET} - {3352669200 7200 1 CEST} - {3370813200 3600 0 CET} - {3384118800 7200 1 CEST} - {3402867600 3600 0 CET} - {3415568400 7200 1 CEST} - {3434317200 3600 0 CET} - {3447018000 7200 1 CEST} - {3465766800 3600 0 CET} - {3479072400 7200 1 CEST} - {3497216400 3600 0 CET} - {3510522000 7200 1 CEST} - {3528666000 3600 0 CET} - {3541971600 7200 1 CEST} - {3560115600 3600 0 CET} - {3573421200 7200 1 CEST} - {3592170000 3600 0 CET} - {3604870800 7200 1 CEST} - {3623619600 3600 0 CET} - {3636320400 7200 1 CEST} - {3655069200 3600 0 CET} - {3668374800 7200 1 CEST} - {3686518800 3600 0 CET} - {3699824400 7200 1 CEST} - {3717968400 3600 0 CET} - {3731274000 7200 1 CEST} - {3750022800 3600 0 CET} - {3762723600 7200 1 CEST} - {3781472400 3600 0 CET} - {3794173200 7200 1 CEST} - {3812922000 3600 0 CET} - {3825622800 7200 1 CEST} - {3844371600 3600 0 CET} - {3857677200 7200 1 CEST} - {3875821200 3600 0 CET} - {3889126800 7200 1 CEST} - {3907270800 3600 0 CET} - {3920576400 7200 1 CEST} - {3939325200 3600 0 CET} - {3952026000 7200 1 CEST} - {3970774800 3600 0 CET} - {3983475600 7200 1 CEST} - {4002224400 3600 0 CET} - {4015530000 7200 1 CEST} - {4033674000 3600 0 CET} - {4046979600 7200 1 CEST} - {4065123600 3600 0 CET} - {4078429200 7200 1 CEST} - {4096573200 3600 0 CET} +if {![info exists TZData(Europe/Zurich)]} { + LoadTimeZoneFile Europe/Zurich } +set TZData(:Europe/Vaduz) $TZData(:Europe/Zurich) diff --git a/library/tzdata/Europe/Zurich b/library/tzdata/Europe/Zurich index 33831c3..87a20db 100644 --- a/library/tzdata/Europe/Zurich +++ b/library/tzdata/Europe/Zurich @@ -2,8 +2,8 @@ set TZData(:Europe/Zurich) { {-9223372036854775808 2048 0 LMT} - {-3827954048 1784 0 BMT} - {-2385246584 3600 0 CET} + {-3675198848 1786 0 BMT} + {-2385246586 3600 0 CET} {-904435200 7200 1 CEST} {-891129600 3600 0 CET} {-872985600 7200 1 CEST} diff --git a/library/tzdata/Pacific/Fiji b/library/tzdata/Pacific/Fiji index bfcaa03..454ee87 100644 --- a/library/tzdata/Pacific/Fiji +++ b/library/tzdata/Pacific/Fiji @@ -15,11 +15,11 @@ set TZData(:Pacific/Fiji) { {1327154400 43200 0 FJT} {1350741600 46800 1 FJST} {1358604000 43200 0 FJT} - {1382191200 46800 1 FJST} + {1382796000 46800 1 FJST} {1390053600 43200 0 FJT} - {1413640800 46800 1 FJST} + {1414245600 46800 1 FJST} {1421503200 43200 0 FJT} - {1445090400 46800 1 FJST} + {1445695200 46800 1 FJST} {1453557600 43200 0 FJT} {1477144800 46800 1 FJST} {1485007200 43200 0 FJT} @@ -27,9 +27,9 @@ set TZData(:Pacific/Fiji) { {1516456800 43200 0 FJT} {1540044000 46800 1 FJST} {1547906400 43200 0 FJT} - {1571493600 46800 1 FJST} + {1572098400 46800 1 FJST} {1579356000 43200 0 FJT} - {1602943200 46800 1 FJST} + {1603548000 46800 1 FJST} {1611410400 43200 0 FJT} {1634997600 46800 1 FJST} {1642860000 43200 0 FJT} @@ -37,11 +37,11 @@ set TZData(:Pacific/Fiji) { {1674309600 43200 0 FJT} {1697896800 46800 1 FJST} {1705759200 43200 0 FJT} - {1729346400 46800 1 FJST} + {1729951200 46800 1 FJST} {1737208800 43200 0 FJT} - {1760796000 46800 1 FJST} + {1761400800 46800 1 FJST} {1768658400 43200 0 FJT} - {1792245600 46800 1 FJST} + {1792850400 46800 1 FJST} {1800712800 43200 0 FJT} {1824300000 46800 1 FJST} {1832162400 43200 0 FJT} @@ -49,9 +49,9 @@ set TZData(:Pacific/Fiji) { {1863612000 43200 0 FJT} {1887199200 46800 1 FJST} {1895061600 43200 0 FJT} - {1918648800 46800 1 FJST} + {1919253600 46800 1 FJST} {1926511200 43200 0 FJT} - {1950098400 46800 1 FJST} + {1950703200 46800 1 FJST} {1957960800 43200 0 FJT} {1982152800 46800 1 FJST} {1990015200 43200 0 FJT} @@ -61,9 +61,9 @@ set TZData(:Pacific/Fiji) { {2052914400 43200 0 FJT} {2076501600 46800 1 FJST} {2084364000 43200 0 FJT} - {2107951200 46800 1 FJST} + {2108556000 46800 1 FJST} {2115813600 43200 0 FJT} - {2139400800 46800 1 FJST} + {2140005600 46800 1 FJST} {2147868000 43200 0 FJT} {2171455200 46800 1 FJST} {2179317600 43200 0 FJT} @@ -71,11 +71,11 @@ set TZData(:Pacific/Fiji) { {2210767200 43200 0 FJT} {2234354400 46800 1 FJST} {2242216800 43200 0 FJT} - {2265804000 46800 1 FJST} + {2266408800 46800 1 FJST} {2273666400 43200 0 FJT} - {2297253600 46800 1 FJST} + {2297858400 46800 1 FJST} {2305116000 43200 0 FJT} - {2328703200 46800 1 FJST} + {2329308000 46800 1 FJST} {2337170400 43200 0 FJT} {2360757600 46800 1 FJST} {2368620000 43200 0 FJT} @@ -83,9 +83,9 @@ set TZData(:Pacific/Fiji) { {2400069600 43200 0 FJT} {2423656800 46800 1 FJST} {2431519200 43200 0 FJT} - {2455106400 46800 1 FJST} + {2455711200 46800 1 FJST} {2462968800 43200 0 FJT} - {2486556000 46800 1 FJST} + {2487160800 46800 1 FJST} {2495023200 43200 0 FJT} {2518610400 46800 1 FJST} {2526472800 43200 0 FJT} @@ -93,11 +93,11 @@ set TZData(:Pacific/Fiji) { {2557922400 43200 0 FJT} {2581509600 46800 1 FJST} {2589372000 43200 0 FJT} - {2612959200 46800 1 FJST} + {2613564000 46800 1 FJST} {2620821600 43200 0 FJT} - {2644408800 46800 1 FJST} + {2645013600 46800 1 FJST} {2652271200 43200 0 FJT} - {2675858400 46800 1 FJST} + {2676463200 46800 1 FJST} {2684325600 43200 0 FJT} {2707912800 46800 1 FJST} {2715775200 43200 0 FJT} @@ -105,9 +105,9 @@ set TZData(:Pacific/Fiji) { {2747224800 43200 0 FJT} {2770812000 46800 1 FJST} {2778674400 43200 0 FJT} - {2802261600 46800 1 FJST} + {2802866400 46800 1 FJST} {2810124000 43200 0 FJT} - {2833711200 46800 1 FJST} + {2834316000 46800 1 FJST} {2841573600 43200 0 FJT} {2865765600 46800 1 FJST} {2873628000 43200 0 FJT} @@ -117,9 +117,9 @@ set TZData(:Pacific/Fiji) { {2936527200 43200 0 FJT} {2960114400 46800 1 FJST} {2967976800 43200 0 FJT} - {2991564000 46800 1 FJST} + {2992168800 46800 1 FJST} {2999426400 43200 0 FJT} - {3023013600 46800 1 FJST} + {3023618400 46800 1 FJST} {3031480800 43200 0 FJT} {3055068000 46800 1 FJST} {3062930400 43200 0 FJT} @@ -127,11 +127,11 @@ set TZData(:Pacific/Fiji) { {3094380000 43200 0 FJT} {3117967200 46800 1 FJST} {3125829600 43200 0 FJT} - {3149416800 46800 1 FJST} + {3150021600 46800 1 FJST} {3157279200 43200 0 FJT} - {3180866400 46800 1 FJST} + {3181471200 46800 1 FJST} {3188728800 43200 0 FJT} - {3212316000 46800 1 FJST} + {3212920800 46800 1 FJST} {3220783200 43200 0 FJT} {3244370400 46800 1 FJST} {3252232800 43200 0 FJT} @@ -139,9 +139,9 @@ set TZData(:Pacific/Fiji) { {3283682400 43200 0 FJT} {3307269600 46800 1 FJST} {3315132000 43200 0 FJT} - {3338719200 46800 1 FJST} + {3339324000 46800 1 FJST} {3346581600 43200 0 FJT} - {3370168800 46800 1 FJST} + {3370773600 46800 1 FJST} {3378636000 43200 0 FJT} {3402223200 46800 1 FJST} {3410085600 43200 0 FJT} @@ -149,11 +149,11 @@ set TZData(:Pacific/Fiji) { {3441535200 43200 0 FJT} {3465122400 46800 1 FJST} {3472984800 43200 0 FJT} - {3496572000 46800 1 FJST} + {3497176800 46800 1 FJST} {3504434400 43200 0 FJT} - {3528021600 46800 1 FJST} + {3528626400 46800 1 FJST} {3535884000 43200 0 FJT} - {3559471200 46800 1 FJST} + {3560076000 46800 1 FJST} {3567938400 43200 0 FJT} {3591525600 46800 1 FJST} {3599388000 43200 0 FJT} @@ -161,9 +161,9 @@ set TZData(:Pacific/Fiji) { {3630837600 43200 0 FJT} {3654424800 46800 1 FJST} {3662287200 43200 0 FJT} - {3685874400 46800 1 FJST} + {3686479200 46800 1 FJST} {3693736800 43200 0 FJT} - {3717324000 46800 1 FJST} + {3717928800 46800 1 FJST} {3725186400 43200 0 FJT} {3749378400 46800 1 FJST} {3757240800 43200 0 FJT} @@ -173,9 +173,9 @@ set TZData(:Pacific/Fiji) { {3820140000 43200 0 FJT} {3843727200 46800 1 FJST} {3851589600 43200 0 FJT} - {3875176800 46800 1 FJST} + {3875781600 46800 1 FJST} {3883039200 43200 0 FJT} - {3906626400 46800 1 FJST} + {3907231200 46800 1 FJST} {3915093600 43200 0 FJT} {3938680800 46800 1 FJST} {3946543200 43200 0 FJT} @@ -183,9 +183,9 @@ set TZData(:Pacific/Fiji) { {3977992800 43200 0 FJT} {4001580000 46800 1 FJST} {4009442400 43200 0 FJT} - {4033029600 46800 1 FJST} + {4033634400 46800 1 FJST} {4040892000 43200 0 FJT} - {4064479200 46800 1 FJST} + {4065084000 46800 1 FJST} {4072341600 43200 0 FJT} - {4095928800 46800 1 FJST} + {4096533600 46800 1 FJST} } diff --git a/library/tzdata/Pacific/Johnston b/library/tzdata/Pacific/Johnston index 7f9fee4..21ab39a 100644 --- a/library/tzdata/Pacific/Johnston +++ b/library/tzdata/Pacific/Johnston @@ -1,5 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Pacific/Johnston) { - {-9223372036854775808 -36000 0 HST} +if {![info exists TZData(Pacific/Honolulu)]} { + LoadTimeZoneFile Pacific/Honolulu } +set TZData(:Pacific/Johnston) $TZData(:Pacific/Honolulu) diff --git a/pkgs/package.list.txt b/pkgs/package.list.txt index a13b0fb..0d5dcf8 100644 --- a/pkgs/package.list.txt +++ b/pkgs/package.list.txt @@ -9,7 +9,10 @@ itcl {[incr Tcl]} Itcl {[incr Tcl]} # SQLite -sqlite SQLite +Sqlite SQLite3 +sqlite SQLite3 +Sqlite3 SQLite3 +sqlite3 SQLite3 # Thread Thread Thread @@ -20,7 +23,13 @@ tdbc TDBC Tdbc TDBC TDBC TDBC # Drivers for TDBC +Tdbcmysql tdbc::mysql tdbcmysql tdbc::mysql +Tdbcodbc tdbc::odbc tdbcodbc tdbc::odbc +Tdbcpostgres tdbc::postgres tdbcpostgres tdbc::postgres +Tdbcsqlite3 tdbc::sqlite3 tdbcsqlite3 tdbc::sqlite3 +Tdbcsqlite tdbc::sqlite3 +tdbcsqlite tdbc::sqlite3 diff --git a/tests/compile.test b/tests/compile.test index 51db0a2..2852bf2 100644 --- a/tests/compile.test +++ b/tests/compile.test @@ -167,6 +167,36 @@ test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*} -cleanup {namespace delete catchtest} } +test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{ + -setup { + namespace eval catchtest { + variable options1 {} + } + trace add variable catchtest::options1 write catchtest::failtrace + proc catchtest::failtrace {n1 n2 op} { + return -code error "trace on $n1 fails by request" + } + } + -body { + proc catchtest::x {} { + variable options1 + set count 0 + for {set i 0} {$i < 10} {incr i} { + set status2 [catch { + set status1 [catch { + return -code error -level 0 "original failure" + } result1 options1] + } result2 options2] + incr count + } + list $count $result2 + } + catchtest::x + } + -result {10 {can't set "options1": trace on options1 fails by request}} + -cleanup {namespace delete catchtest} +} + test compile-4.1 {TclCompileForCmd: command substituted test expression} { set i 0 set j 0 @@ -713,6 +743,70 @@ test compile-19.0 {Bug 3614102: reset stack housekeeping} -body { apply {{} {list [if 1]}} } -returnCodes error -match glob -result * +test compile-20.1 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + return -code continue -level 0 + } + } + return +} {} +test compile-20.2 {ensure there are no infinite loops in optimizing} { + tcl::unsupported::disassemble script { + while 1 { + while 1 { + return -code break -level 0 + } + } + } + return +} {} + +test compile-21.1 {stack balance management} { + apply {{} { + set result {} + while 1 { + lappend result a + lappend result [list b [break]] + lappend result c + } + return $result + }} +} a +test compile-21.2 {stack balance management} { + apply {{} { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [list b [continue] c] + lappend result c + } + return $result + }} +} {1 2 3 4 5 6 7 8 9 10} +test compile-21.3 {stack balance management} { + apply {args { + set result {} + while 1 { + lappend result a + lappend result [concat {*}$args [break]] + lappend result c + } + return $result + }} P Q R S T +} a +test compile-21.4 {stack balance management} { + apply {args { + set result {} + while {[incr i] <= 10} { + lappend result $i + lappend result [concat {*}$args [continue] c] + lappend result c + } + return $result + }} P Q R S T +} {1 2 3 4 5 6 7 8 9 10} + # TODO sometime - check that bytecode from tbcload is *not* disassembled. # cleanup diff --git a/tests/coroutine.test b/tests/coroutine.test index 03c63ad..a360fd5 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.test @@ -342,6 +342,9 @@ test coroutine-3.6 {info frame, bug #2910094} -setup { rename stack {} rename a {} } -result {} +test coroutine-3.7 {bug 0b874c344d} { + dict get [coroutine X coroutine Y info frame 0] cmd +} {coroutine X coroutine Y info frame 0} test coroutine-4.1 {bug #2093188} -setup { proc foo {} { diff --git a/tests/env.test b/tests/env.test index fa76433..83d99e0 100644 --- a/tests/env.test +++ b/tests/env.test @@ -218,8 +218,8 @@ test env-4.5 {unsetting international environment variables} -setup { unset env(\ua7) getenv } -constraints {exec} -cleanup { - encoding system $sysenc unset env(\ub6) + encoding system $sysenc } -result {\u00b6=\u00a7} test env-5.0 {corner cases - set a value, it should exist} -body { @@ -291,6 +291,29 @@ test env-6.1 {corner cases - add lots of env variables} {} { expr {[array size env] - $size} } 100 +test env-7.1 {[219226]: whole env array should not be unset by read} { + set n [array size env] + set s [array startsearch env] + while {[array anymore env $s]} { + array nextelement env $s + incr n -1 + } + array donesearch env $s + return $n +} 0 +test env-7.2 {[219226]: links to env elements should not be removed by read} { + apply {{} { + set ::env(test7_2) ok + upvar env(test7_2) elem + set ::env(PATH) + try { + return $elem + } finally { + unset ::env(test7_2) + } + }} +} ok + # Restore the environment variables at the end of the test. foreach name [array names env] { diff --git a/tests/for.test b/tests/for.test index 8936682..8abd270 100644 --- a/tests/for.test +++ b/tests/for.test @@ -942,6 +942,248 @@ test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} expr {$end - $tmp} }} } 0 +test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code break}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [apply {{} {return -code continue}}] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory { + apply {{} { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[apply {{} { + return -code continue + }}] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code break + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory { + apply {{} { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} { + return -code continue + }}] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} +} 0 +test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {$x < 5} {incr x} { + list a b c [{*}$op] d e f + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory { + apply {op { + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts {*}[puts a b c {*}[{*}$op] d e f] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + } + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 +test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code break} +} 0 +test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory { + apply {op { + set l [lrepeat 50 p q r] + # Can't use [memtest]; must be careful when we change stack frames + set end [meminfo] + for {set i 0} {$i < 5} {incr i} { + unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} { + puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]] + }] + set tmp $end + set end [meminfo] + } + expr {$end - $tmp} + }} {return -level 0 -code continue} +} 0 # cleanup ::tcltest::cleanupTests diff --git a/tests/http.test b/tests/http.test index 7d439b1..a52cfb1 100644 --- a/tests/http.test +++ b/tests/http.test @@ -119,7 +119,7 @@ test http-3.2 {http::geturl} -returnCodes error -body { http::geturl http:junk } -result {Unsupported URL: http:junk} set url //[info hostname]:$port -set badurl //[info hostname]:6666 +set badurl //[info hostname]:[expr $port+1] test http-3.3 {http::geturl} -body { set token [http::geturl $url] http::data $token @@ -131,7 +131,7 @@ test http-3.3 {http::geturl} -body { </body></html>" set tail /a/b/c set url //[info hostname]:$port/a/b/c -set fullurl http://user:pass@[info hostname]:$port/a/b/c +set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost diff --git a/tests/load.test b/tests/load.test index cded85d..9536271 100644 --- a/tests/load.test +++ b/tests/load.test @@ -215,6 +215,12 @@ test load-10.1 {load from vfs} \ -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \ -result {0 {}} \ -cleanup {testsimplefilesystem 0; cd $dir; unset dir} + +test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \ + [list $dll $loaded] { + load [file join $testDir pkgooa$ext] + list [pkgooa_stubsok] [lsort [info commands pkgooa_*]] +} {1 pkgooa_stubsok} # cleanup unset ext diff --git a/tests/oo.test b/tests/oo.test index 37bbadb..d63e931 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -101,7 +101,7 @@ test oo-0.8 {leak in variable management} -setup { test oo-0.9 {various types of presence of the TclOO package} { list [lsearch -nocase -all -inline [package names] tcloo] \ [package present TclOO] [package versions TclOO] -} [list TclOO $::oo::version $::oo::version] +} [list TclOO $::oo::patchlevel $::oo::patchlevel] test oo-1.1 {basic test of OO functionality: no classes} { set result {} diff --git a/tests/scan.test b/tests/scan.test index ea0c500..b57b641 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -375,6 +375,12 @@ test scan-4.48 {Tcl_ScanObjCmd, float scanning} { test scan-4.49 {Tcl_ScanObjCmd, float scanning} { list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z } {3 0.1 0.2 3.0} +test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} { + list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} +test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} { + list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} test scan-4.50 {Tcl_ScanObjCmd, float scanning} { list [scan {1234567890a} %f x] $x } {1 1234567890.0} @@ -450,6 +456,9 @@ test scan-4.63 {scanning of large and negative hex integers} { list [scan $scanstring {%x %x %x} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} +test scan-4.64 {scanning of hex with %X} { + scan "123 abc f78" %X%X%X +} {291 2748 3960} test scan-5.1 {integer scanning} -setup { set a {}; set b {}; set c {}; set d {} @@ -626,14 +635,14 @@ test scan-8.4 {error conditions} -returnCodes error -body { scan a %O x } -result {bad scan conversion character "O"} test scan-8.5 {error conditions} -returnCodes error -body { - scan a %X x -} -result {bad scan conversion character "X"} + scan a %B x +} -result {bad scan conversion character "B"} test scan-8.6 {error conditions} -returnCodes error -body { scan a %F x } -result {bad scan conversion character "F"} test scan-8.7 {error conditions} -returnCodes error -body { - scan a %E x -} -result {bad scan conversion character "E"} + scan a %p x +} -result {bad scan conversion character "p"} test scan-8.8 {error conditions} -returnCodes error -body { scan a "%d %d" a } -result {different numbers of variable names and field specifiers} diff --git a/tests/socket.test b/tests/socket.test index 5542c09..51219e6 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1841,6 +1841,7 @@ test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \ after cancel $after close $client close $server + unset x } -result {{} bye} test socket-14.5 {[socket -async] which fails before any connect() can be made} \ -constraints [list socket supported_any] \ @@ -1850,6 +1851,33 @@ test socket-14.5 {[socket -async] which fails before any connect() can be made} } \ -returnCodes 1 \ -result {couldn't open socket: cannot assign requested address} +test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \ + -constraints [list socket supported_inet supported_inet6] \ + -setup { + proc accept {s a p} { + puts $s bye + close $s + } + set server [socket -server accept -myaddr 127.0.0.1 0] + set port [lindex [fconfigure $server -sockname] 2] + set x "" + } \ + -body { + set client [socket -async localhost $port] + foreach _ {1 2} { + lappend x [lindex [fconfigure $client -sockname] 0] + lappend x [fconfigure $client -error] + update + } + lappend x [gets $client] + } \ + -cleanup { + close $server + close $client + unset x + } \ + -result [list ::1 "connection refused" 127.0.0.1 "" bye] + ::tcltest::cleanupTests flush stdout return diff --git a/tests/source.test b/tests/source.test index d71212d..0235bd1 100644 --- a/tests/source.test +++ b/tests/source.test @@ -187,6 +187,16 @@ test source-3.5 {return with special code etc.} -setup { invoked from within "source $sourcefile"} {a b c}} +test source-4.1 {continuation line parsing} -setup { + set sourcefile [makeFile [string map {CL \\\n} { + format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]" + }] source.file] +} -body { + source $sourcefile +} -cleanup { + removeFile source.file +} -result {source: 3 4 5} + test source-6.1 {source is binary ok} -setup { # Note [makeFile] writes in the system encoding. # [source] defaults to reading in the system encoding. diff --git a/tests/zlib.test b/tests/zlib.test index 0712929..4e51ebb 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -16,6 +16,13 @@ if {"::tcltest" ni [namespace children]} { } testConstraint zlib [llength [info commands zlib]] +testConstraint recentZlib 0 +catch { + # Work around a bug in some versions of zlib; known to manifest on at + # least Mac OS X Mountain Lion... + testConstraint recentZlib \ + [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6] +} test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body { zlib @@ -269,7 +276,7 @@ test zlib-8.9 {transformation and fconfigure} -setup { } -result {3064818174 358 358} test zlib-8.10 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide -} -constraints zlib -body { +} -constraints {zlib recentZlib} -body { zlib push deflate $outSide -dictionary $spdyDict fconfigure $outSide -blocking 0 -translation binary -buffering none fconfigure $inSide -blocking 0 -translation binary diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 93e0a9a..b45e560 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -983,6 +983,8 @@ proc genStubs::emitHeader {name} { append text "#define ${CAPName}_STUBS_REVISION $revision\n" } + append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + emitDeclarations $name text if {[info exists hooks($name)]} { @@ -1010,8 +1012,7 @@ proc genStubs::emitHeader {name} { append text "} ${capName}Stubs;\n\n" - append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" - append text "extern const ${capName}Stubs *${name}StubsPtr;\n" + append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index fe4e7ad..9c8f503 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -717,7 +717,7 @@ proc char {name} { textSetup puts -nonewline $file "\\'d7 " } - {\(em} { + {\(em} - {\(en} { textSetup puts -nonewline $file "-" } diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl index d02bcb6..8fd1245 100644 --- a/tools/tcltk-man2html-utils.tcl +++ b/tools/tcltk-man2html-utils.tcl @@ -142,6 +142,7 @@ proc process-text {text} { {\(+-} "±" \ {\(co} "©" \ {\(em} "—" \ + {\(en} "–" \ {\(fm} "′" \ {\(mu} "×" \ {\(mi} "−" \ @@ -900,7 +901,7 @@ proc insert-cross-references {text} { append result [string range $text 0 [expr {$off-1}]] regexp -indices -start $off {http://[\w/.]+} $text range set url [string range $text {*}$range] - append result "<A HREF=\"$url\">" $url "</A>" + append result "<A HREF=\"[string trimright $url .]\">$url</A>" set text [string range $text[set text ""] \ [expr {[lindex $range 1]+1}] end] continue diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index f392bce..89e8e5c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -470,6 +470,7 @@ proc plus-pkgs {type args} { continue } } + set dir [string trimright $dir "0123456789-."] switch $type { n { set title "$name Package Commands" @@ -647,10 +648,12 @@ try { append appdir "$tkdir" } + apply {{} { + global packageBuildList tcltkdir tcldir build_tcl # When building docs for Tcl, try to build docs for bundled packages too set packageBuildList {} - if {$build_tcl} { + if {$build_tcl} { set pkgsDir [file join $tcltkdir $tcldir pkgs] set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *] @@ -693,7 +696,8 @@ try { foreach line [split [read $f] \n] { if {[string trim $line] eq ""} continue if {[string match #* $line]} continue - lappend packageDirNameMap {*}$line + lassign $line dir name + lappend packageDirNameMap $dir $name } } finally { close $f @@ -714,6 +718,7 @@ try { lset packageBuildList $idx+1 [dict get $packageDirNameMap $n] } } + }} # # Invoke the scraper/converter engine. diff --git a/unix/Makefile.in b/unix/Makefile.in index 62bda0f..58e0074 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -614,7 +614,7 @@ SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \ all: binaries libraries doc packages -binaries: ${LIB_FILE} $(STUB_LIB_FILE) ${TCL_EXE} +binaries: ${LIB_FILE} ${TCL_EXE} libraries: @@ -622,12 +622,14 @@ doc: # The following target is configured by autoconf to generate either a shared # library or non-shared library for Tcl. -${LIB_FILE}: ${OBJS} ${STUB_LIB_FILE} +${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} rm -f $@ @MAKE_LIB@ - ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} + @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ + (cd ${TOP_DIR}/win; ${MAKE} tcldde14.dll tclreg13.dll); \ + fi rm -f $@ @MAKE_STUB_LIB@ @@ -842,8 +844,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.8.7 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.7.tm; + @echo "Installing package http 2.8.8 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.8.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ @@ -851,8 +853,8 @@ install-libraries: libraries done; @echo "Installing package msgcat 1.5.2 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm; - @echo "Installing package tcltest 2.3.6 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.6.tm; + @echo "Installing package tcltest 2.3.7 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.7.tm; @echo "Installing package platform 1.0.12 as a Tcl Module"; @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.12.tm; @@ -1034,6 +1036,7 @@ IOHDR=$(GENERIC_DIR)/tclIO.h MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h PARSEHDR=$(GENERIC_DIR)/tclParse.h NREHDR=$(GENERIC_DIR)/tclInt.h +TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \ $(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \ @@ -1079,7 +1082,7 @@ tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c -tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) +tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c tclDate.o: $(GENERIC_DIR)/tclDate.c @@ -1091,7 +1094,7 @@ tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR) tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c -tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) +tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsSZ.c tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c $(COMPILEHDR) @@ -1197,6 +1200,7 @@ tclLoadDld.o: $(UNIX_DIR)/tclLoadDld.c $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDld.c tclLoadDyld.o: $(UNIX_DIR)/tclLoadDyld.c + @echo Warnings are expected from compiling tclLoadDyld.c: deprecated API use $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadDyld.c tclLoadNone.o: $(GENERIC_DIR)/tclLoadNone.c @@ -1310,7 +1314,7 @@ tclStubInit.o: $(GENERIC_DIR)/tclStubInit.c tclTrace.o: $(GENERIC_DIR)/tclTrace.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTrace.c -tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR) +tclUtil.o: $(GENERIC_DIR)/tclUtil.c $(PARSEHDR) $(TRIMHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclUtil.c tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c @@ -1611,7 +1615,7 @@ $(DTRACE_OBJ): $(DTRACE_SRC) $(TCL_OBJS) # notifier can modify them to suit their own installation. #-------------------------------------------------------------------------- -xttest: ${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} +xttest: ${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST} ${CC} ${CFLAGS} ${LDFLAGS} ${XTTEST_OBJS} \ @TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \ ${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest @@ -1953,6 +1957,7 @@ $(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure cd $(MAC_OSX_DIR); autoheader; touch $@ +EOLFIX=$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure genstubs dist-packages ${NATIVE_TCLSH} rm -rf $(DISTDIR) mkdir -p $(DISTDIR)/unix @@ -1968,7 +1973,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in chmod 775 $(DISTDIR)/unix/ldAix - mkdir $(DISTDIR)/generic + @mkdir $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic @@ -1976,7 +1981,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README* \ $(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \ $(DISTDIR) - mkdir $(DISTDIR)/library + @mkdir $(DISTDIR)/library cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library for i in http1.0 http opt msgcat reg dde tcltest platform; \ @@ -1984,31 +1989,32 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M mkdir $(DISTDIR)/library/$$i ;\ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \ done; - mkdir $(DISTDIR)/library/encoding + @mkdir $(DISTDIR)/library/encoding cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding - mkdir $(DISTDIR)/library/msgs + @mkdir $(DISTDIR)/library/msgs cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs - ( cd $(TOP_DIR); \ + @echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata + @( cd $(TOP_DIR); \ find library/tzdata -name CVS -prune -o -type f -print ) \ | ( cd $(TOP_DIR) ; xargs tar cf - ) \ | ( cd $(DISTDIR) ; tar xfp - ) - mkdir $(DISTDIR)/doc + @mkdir $(DISTDIR)/doc cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \ $(TOP_DIR)/doc/man.macros $(DISTDIR)/doc - mkdir $(DISTDIR)/compat + @mkdir $(DISTDIR)/compat cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \ $(COMPAT_DIR)/README $(DISTDIR)/compat - mkdir $(DISTDIR)/compat/zlib + @mkdir $(DISTDIR)/compat/zlib ( cd $(COMPAT_DIR)/zlib; \ find . -name CVS -prune -o -type f -print ) \ | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \ | ( cd $(DISTDIR)/compat/zlib ; tar xfp - ) - mkdir $(DISTDIR)/tests + @mkdir $(DISTDIR)/tests cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \ $(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \ $(DISTDIR)/tests - mkdir $(DISTDIR)/win + @mkdir $(DISTDIR)/win cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \ $(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \ @@ -2017,49 +2023,48 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \ $(DISTDIR)/win cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/*.bat + @$(EOLFIX) -crlf $(DISTDIR)/win/*.bat cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/makefile.* + @$(EOLFIX) -crlf $(DISTDIR)/win/makefile.bc $(DISTDIR)/win/makefile.vc cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/rules.vc + @$(EOLFIX) -crlf $(DISTDIR)/win/rules.vc cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/coffbase.txt + @$(EOLFIX) -crlf $(DISTDIR)/win/coffbase.txt cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.hpj.in + @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.hpj.in cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/win/tcl.ds* + @$(EOLFIX) -crlf $(DISTDIR)/win/tcl.ds* cp -p $(TOP_DIR)/win/README $(DISTDIR)/win cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win - mkdir $(DISTDIR)/macosx + @mkdir $(DISTDIR)/macosx cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \ $(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \ $(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \ $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx - mkdir $(DISTDIR)/macosx/Tcl.xcode + @mkdir $(DISTDIR)/macosx/Tcl.xcode cp -p $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcode - mkdir $(DISTDIR)/macosx/Tcl.xcodeproj + @mkdir $(DISTDIR)/macosx/Tcl.xcodeproj cp -p $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \ $(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \ $(DISTDIR)/macosx/Tcl.xcodeproj - mkdir $(DISTDIR)/unix/dltest + @mkdir $(DISTDIR)/unix/dltest cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \ - $(UNIX_DIR)/dltest/README \ - $(DISTDIR)/unix/dltest - mkdir $(DISTDIR)/tools + $(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest + @mkdir $(DISTDIR)/tools cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \ $(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \ $(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \ $(DISTDIR)/tools - $(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in - mkdir $(DISTDIR)/libtommath - cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \ - $(DISTDIR)/libtommath - mkdir $(DISTDIR)/pkgs + @$(EOLFIX) -crlf $(DISTDIR)/tools/tcl.hpj.in + @mkdir $(DISTDIR)/libtommath + cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath + @mkdir $(DISTDIR)/pkgs cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs + cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done @@ -2079,6 +2084,9 @@ alldist: dist # build of this HTML documentation that has already been placed online. As # such, this rule is not guaranteed to work well on all systems; it only needs # to function on those of the Tcl/Tk maintainers. +# +# Also note that the 8.6 tool build requires an installed 8.6 native Tcl +# interpreter in order to be able to run. #-------------------------------------------------------------------------- html: ${NATIVE_TCLSH} @@ -2091,9 +2099,12 @@ html-tk: ${NATIVE_TCLSH} $(BUILD_HTML) --tk @EXTRA_BUILD_HTML@ +# You'd better have these programs or you will have problems creating Makefile +# from Makefile.in in the first place... +HTML_VERSION = `basename $(TOP_DIR) | sed s/tcl//` BUILD_HTML = \ @${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \ - --htmldir="$(HTML_INSTALL_DIR)" \ + --useversion=$(HTML_VERSION) --htmldir="$(HTML_INSTALL_DIR)" \ --srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS) #-------------------------------------------------------------------------- diff --git a/unix/configure b/unix/configure index 06ff7a4..0e231ab 100755 --- a/unix/configure +++ b/unix/configure @@ -6490,80 +6490,6 @@ if test "${tcl_cv_cc_visibility_hidden+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else - if test "$SHARED_BUILD" = 1; then - - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror" - cat >conftest.$ac_ext <<_ACEOF -/* confdefs.h. */ -_ACEOF -cat confdefs.h >>conftest.$ac_ext -cat >>conftest.$ac_ext <<_ACEOF -/* end confdefs.h. */ - -int -main () -{ -#if !defined(__GNUC__) || __GNUC__ < 4 -#error visibility hidden is not supported for this compiler -#endif - - ; - return 0; -} -_ACEOF -rm -f conftest.$ac_objext -if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 - (eval $ac_compile) 2>conftest.er1 - ac_status=$? - grep -v '^ *+' conftest.er1 >conftest.err - rm -f conftest.er1 - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } && - { ac_try='test -z "$ac_c_werror_flag" - || test ! -s conftest.err' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; } && - { ac_try='test -s conftest.$ac_objext' - { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 - (eval $ac_try) 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); }; }; then - tcl_cv_cc_visibility_hidden=yes -else - echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -tcl_cv_cc_visibility_hidden=no -fi -rm -f conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS=$hold_cflags - -else - - tcl_cv_cc_visibility_hidden=no - -fi - - -fi -echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 -echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 - if test $tcl_cv_cc_visibility_hidden = yes; then - - CFLAGS="$CFLAGS -fvisibility=hidden" - -cat >>confdefs.h <<\_ACEOF -#define MODULE_SCOPE extern -_ACEOF - - -else - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ @@ -6614,7 +6540,10 @@ fi rm -f conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS=$hold_cflags - if test $tcl_cv_cc_visibility_hidden = yes; then +fi +echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5 +echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6 + if test $tcl_cv_cc_visibility_hidden = yes; then cat >>confdefs.h <<\_ACEOF @@ -6630,9 +6559,6 @@ _ACEOF fi -fi - - # Step 0.d: Disable -rpath support? echo "$as_me:$LINENO: checking if rpath support is requested" >&5 @@ -7150,10 +7076,15 @@ echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;} echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;} { (exit 1); exit 1; }; } fi - if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then - { { echo "$as_me:$LINENO: error: Please configure and make the ../win directory first." >&5 -echo "$as_me: error: Please configure and make the ../win directory first." >&2;} - { (exit 1); exit 1; }; } + do64bit_ok=yes + if test "x${SHARED_BUILD}" = "x1"; then + echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" + # The eval makes quoting arguments work. + if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix + then : + else + { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } + fi fi ;; dgux*) @@ -8145,7 +8076,6 @@ cat >>confdefs.h <<\_ACEOF #define MODULE_SCOPE __private_extern__ _ACEOF - tcl_cv_cc_visibility_hidden=yes fi diff --git a/unix/dltest/Makefile.in b/unix/dltest/Makefile.in index 01589d9..25b9376 100644 --- a/unix/dltest/Makefile.in +++ b/unix/dltest/Makefile.in @@ -22,14 +22,14 @@ LDFLAGS_DEBUG = @LDFLAGS_DEBUG@ LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@ LDFLAGS = @LDFLAGS_DEFAULT@ @LDFLAGS@ -CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \ +CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \ ${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS} -all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} +all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX} @if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi @touch ../dltest.marker -dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} +dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX} @touch ../dltest.marker pkga.o: $(SRC_DIR)/pkga.c @@ -50,6 +50,9 @@ pkge.o: $(SRC_DIR)/pkge.c pkgua.o: $(SRC_DIR)/pkgua.c $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c +pkgooa.o: $(SRC_DIR)/pkgooa.c + $(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c + pkga${SHLIB_SUFFIX}: pkga.o ${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS} @@ -68,6 +71,9 @@ pkge${SHLIB_SUFFIX}: pkge.o pkgua${SHLIB_SUFFIX}: pkgua.o ${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +pkgooa${SHLIB_SUFFIX}: pkgooa.o + ${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} + pkga${DLTEST_SUFFIX}: pkga.o ${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS} @@ -86,6 +92,9 @@ pkge${DLTEST_SUFFIX}: pkge.o pkgua${DLTEST_SUFFIX}: pkgua.o ${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS} +pkgooa${DLTEST_SUFFIX}: pkgooa.o + ${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS} + clean: rm -f *.o lib.exp ../dltest.marker @if test "$(SHLIB_SUFFIX)" != ""; then \ diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c new file mode 100644 index 0000000..78af376 --- /dev/null +++ b/unix/dltest/pkgooa.c @@ -0,0 +1,141 @@ +/* + * pkgooa.c -- + * + * This file contains a simple Tcl package "pkgooa" that is intended for + * testing the Tcl dynamic loading facilities. + * + * Copyright (c) 1995 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#undef STATIC_BUILD +#include "tclOO.h" +#include <string.h> + +/* + *---------------------------------------------------------------------- + * + * Pkgooa_StubsOKObjCmd -- + * + * This procedure is invoked to process the "pkgooa_stubsok" Tcl command. + * It gives 1 if stubs are used correctly, 0 if stubs are not OK. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +static int +Pkgooa_StubsOKObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance)); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * Pkgooa_Init -- + * + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. + * + * Results: + * None. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +extern void *tclOOIntStubsPtr; + +static TclOOStubs stubsCopy = { + TCL_STUB_MAGIC, + NULL, + /* It doesn't really matter what implementation of + * Tcl_CopyObjectInstance is put in the "pseudo" + * stub table, since the test-case never actually + * calls this function. All that matters is that it's + * a function with a different memory address than + * the real Tcl_CopyObjectInstance function in Tcl. */ + (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *, + const char *t)) Pkgooa_StubsOKObjCmd + /* More entries could be here, but those are not used + * for this test-case. So, being NULL is OK. */ +}; + +extern DLLEXPORT int +Pkgooa_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ +{ + int code; + + /* Any TclOO extension which uses stubs, calls + * both Tcl_InitStubs and Tcl_OOInitStubs() and + * does not use any Tcl 8.6 features should be + * loadable in Tcl 8.5 as well, provided the + * TclOO extension (for Tcl 8.5) is installed. + * This worked in Tcl 8.6.0, and is expected + * to keep working in all future Tcl 8.x releases. + */ + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { + return TCL_ERROR; + } + if (tclStubsPtr == NULL) { + Tcl_AppendResult(interp, "Tcl stubs are not inialized, " + "did you compile using -DUSE_TCL_STUBS? "); + return TCL_ERROR; + } + if (Tcl_OOInitStubs(interp) == NULL) { + return TCL_ERROR; + } + if (tclOOStubsPtr == NULL) { + Tcl_AppendResult(interp, "TclOO stubs are not inialized"); + return TCL_ERROR; + } + if (tclOOIntStubsPtr == NULL) { + Tcl_AppendResult(interp, "TclOO internal stubs are not inialized"); + return TCL_ERROR; + } + + /* Test case for Bug [f51efe99a7]. + * + * Let tclOOStubsPtr point to an alternate stub table + * (with only a single function, that's enough for + * this test). This way, the function "pkgooa_stubsok" + * can check whether the TclOO function calls really + * use the stub table, or only pretend to. + * + * On platforms without backlinking (Windows, Cygwin, + * AIX), this code doesn't even compile without using + * stubs, but on UNIX ELF systems, the problem is + * less visible. + */ + + tclOOStubsPtr = &stubsCopy; + + code = Tcl_PkgProvide(interp, "Pkgooa", "1.0"); + if (code != TCL_OK) { + return code; + } + Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL); + return TCL_OK; +} diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 194cf90..8c29334 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -111,9 +111,9 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \ `ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do if test -f "$i/unix/tclConfig.sh" ; then - ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" - break - fi + ac_cv_c_tclconfig="`(cd $i/unix; pwd)`" + break + fi done fi ]) @@ -271,11 +271,10 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE -# #------------------------------------------------------------------------ AC_DEFUN([SC_LOAD_TCLCONFIG], [ @@ -439,11 +438,11 @@ AC_DEFUN([SC_LOAD_TKCONFIG], [ # extension can't assume that an executable Tcl shell exists at # build time. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following vars: # TCLSH_PROG #------------------------------------------------------------------------ @@ -484,11 +483,11 @@ AC_DEFUN([SC_PROG_TCLSH], [ # when running tests from an extension build directory. It is not # correct to use the TCLSH_PROG in cases like this. # -# Arguments +# Arguments: # none # -# Results -# Subst's the following values: +# Results: +# Substitutes the following values: # BUILD_TCLSH #------------------------------------------------------------------------ @@ -790,7 +789,6 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # # Defines the following vars: # HAVE_LANGINFO Triggers use of nl_langinfo if defined. -# #------------------------------------------------------------------------ AC_DEFUN([SC_ENABLE_LANGINFO], [ @@ -1045,34 +1043,17 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AC_CACHE_CHECK([if compiler supports visibility "hidden"], tcl_cv_cc_visibility_hidden, [ - AS_IF([test "$SHARED_BUILD" = 1], [ - hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -fvisibility=hidden -Werror" - AC_TRY_COMPILE(,[#if !defined(__GNUC__) || __GNUC__ < 4 -#error visibility hidden is not supported for this compiler -#endif - ], tcl_cv_cc_visibility_hidden=yes, - tcl_cv_cc_visibility_hidden=no) - CFLAGS=$hold_cflags - ], [ - tcl_cv_cc_visibility_hidden=no - ]) - ]) - AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ - CFLAGS="$CFLAGS -fvisibility=hidden" - AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden]) - ], [ hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror" AC_TRY_LINK([ extern __attribute__((__visibility__("hidden"))) void f(void); void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes, tcl_cv_cc_visibility_hidden=no) - CFLAGS=$hold_cflags - AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ - AC_DEFINE(MODULE_SCOPE, - [extern __attribute__((__visibility__("hidden")))], - [Compiler support for module scope symbols]) - AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) - ]) + CFLAGS=$hold_cflags]) + AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [ + AC_DEFINE(MODULE_SCOPE, + [extern __attribute__((__visibility__("hidden")))], + [Compiler support for module scope symbols]) + AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols]) ]) # Step 0.d: Disable -rpath support? @@ -1253,8 +1234,15 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "x${TCL_THREADS}" = "x0"; then AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads]) fi - if test "x${SHARED_BUILD}" = "x1" -a ! -f "../win/tcldde14.dll" -a ! -f "../win/tk86.dll"; then - AC_MSG_ERROR([Please configure and make the ../win directory first.]) + do64bit_ok=yes + if test "x${SHARED_BUILD}" = "x1"; then + echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args" + # The eval makes quoting arguments work. + if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix + then : + else + { echo "configure: error: configure failed for ../win" 1>&2; exit 1; } + fi fi ;; dgux*) @@ -1638,7 +1626,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [ AC_DEFINE(MODULE_SCOPE, [__private_extern__], [Compiler support for module scope symbols]) - tcl_cv_cc_visibility_hidden=yes ]) CC_SEARCH_FLAGS="" LD_SEARCH_FLAGS="" diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c index c6c9759..b234667 100644 --- a/unix/tclUnixNotfy.c +++ b/unix/tclUnixNotfy.c @@ -194,7 +194,7 @@ static Tcl_ThreadId notifierThread; #ifdef TCL_THREADS static void NotifierThreadProc(ClientData clientData); -#ifdef HAVE_PTHREAD_ATFORK +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) static int atForkInit = 0; static void AtForkPrepare(void); static void AtForkParent(void); @@ -290,7 +290,7 @@ Tcl_InitNotifier(void) */ Tcl_MutexLock(¬ifierMutex); -#ifdef HAVE_PTHREAD_ATFORK +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) /* * Install pthread_atfork handlers to reinitialize the notifier in the * child of a fork. @@ -304,7 +304,7 @@ Tcl_InitNotifier(void) } atForkInit = 1; } -#endif +#endif /* HAVE_PTHREAD_ATFORK */ /* * Check if my process id changed, e.g. I was forked * In this case, restart the notifier thread and close the @@ -1313,7 +1313,7 @@ NotifierThreadProc( TclpThreadExit(0); } -#ifdef HAVE_PTHREAD_ATFORK +#if defined(HAVE_PTHREAD_ATFORK) && !defined(__APPLE__) && !defined(__hpux) /* *---------------------------------------------------------------------- * diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index a6360c2..49a6460 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -737,7 +737,10 @@ TcpGetOptionProc( if (statePtr->status == 0) { ret = getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &err, &optlen); + (char *) &err, &optlen); + if (statePtr->flags & TCP_ASYNC_CONNECT) { + statePtr->status = err; + } if (ret < 0) { err = errno; } @@ -1054,12 +1057,17 @@ CreateClientSocket( */ optlen = sizeof(int); - getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR, - (char *) &status, &optlen); - state->status = status; + + if (state->status == 0) { + getsockopt(state->fds.fd, SOL_SOCKET, SO_ERROR, + (char *) &status, &optlen); + state->status = status; + } else { + status = state->status; + state->status = 0; + } } if (status == 0) { - CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT); goto out; } } @@ -1067,6 +1075,7 @@ CreateClientSocket( out: + CLEAR_BITS(state->flags, TCP_ASYNC_CONNECT); if (async_callback) { /* * An asynchonous connection has finally succeeded or failed. @@ -1131,7 +1140,7 @@ Tcl_OpenTcpClient( { TcpState *state; const char *errorMsg = NULL; - void *addrlist = NULL, *myaddrlist = NULL; + struct addrinfo *addrlist = NULL, *myaddrlist = NULL; char channelName[SOCK_CHAN_LENGTH]; /* @@ -1276,8 +1285,7 @@ Tcl_OpenTcpServer( ClientData acceptProcData) /* Data for the callback. */ { int status = 0, sock = -1, reuseaddr = 1, chosenport = 0; - void *addrlist = NULL; - struct addrinfo *addrPtr; /* socket address */ + struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */ TcpState *statePtr = NULL; char channelName[SOCK_CHAN_LENGTH]; const char *errorMsg = NULL; diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index b3e07a4..4b0f369 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -566,12 +566,11 @@ TestforkObjCmd( "Cannot fork", NULL); return TCL_ERROR; } -#if !defined(HAVE_PTHREAD_ATFORK) || defined(MAC_OSX_TCL) - /* Only needed when pthread_atfork is not present or on OSX. */ + /* Only needed when pthread_atfork is not present, + * should not hurt otherwise. */ if (pid==0) { Tcl_InitNotifier(); } -#endif Tcl_SetObjResult(interp, Tcl_NewIntObj(pid)); return TCL_OK; } diff --git a/win/Makefile.in b/win/Makefile.in index 314a495..eecab5e 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -434,7 +434,7 @@ $(CAT32): cat32.$(OBJEXT) ${TCL_STUB_LIB_FILE}: ${STUB_OBJS} @$(RM) ${TCL_STUB_LIB_FILE} - @MAKE_LIB@ ${STUB_OBJS} + @MAKE_STUB_LIB@ ${STUB_OBJS} @POST_MAKE_LIB@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @@ -447,13 +447,13 @@ ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS} @POST_MAKE_LIB@ -${DDE_DLL_FILE}: ${DDE_OBJS} ${TCL_STUB_LIB_FILE} +${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS} @MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${REG_DLL_FILE}: ${REG_OBJS} ${TCL_STUB_LIB_FILE} +${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS} @MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) -${TEST_DLL_FILE}: ${TCLTEST_OBJS} ${TCL_STUB_LIB_FILE} +${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} @$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE} @MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS) @@ -642,8 +642,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.8.7 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.7.tm; + @echo "Installing package http 2.8.8 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.8.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ @@ -651,8 +651,8 @@ install-libraries: libraries install-tzdata install-msgs done; @echo "Installing package msgcat 1.5.2 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm; - @echo "Installing package tcltest 2.3.6 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.6.tm; + @echo "Installing package tcltest 2.3.7 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.7.tm; @echo "Installing package platform 1.0.12 as a Tcl Module"; @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.12.tm; @echo "Installing package platform::shell 1.1.4 as a Tcl Module"; diff --git a/win/configure b/win/configure index be9c98a..569172e 100755 --- a/win/configure +++ b/win/configure @@ -309,7 +309,7 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' +ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. @@ -3450,7 +3450,7 @@ echo "${ECHO_T}yes" >&6 if test "${GCC}" = "yes" ; then extra_cflags="-pipe" - extra_ldflags="-pipe" + extra_ldflags="-pipe -static-libgcc" echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5 echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6 if test "${ac_cv_win32+set}" = set; then @@ -3579,7 +3579,6 @@ echo "${ECHO_T}$ac_cv_municode" >&6 extra_ldflags="$extra_ldflags -municode" else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" - extra_ldflags="$extra_ldflags -static-libgcc" fi fi @@ -3598,6 +3597,7 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6 RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \$@" + MAKE_STUB_LIB="\${STLIB_LD} \$@" POST_MAKE_LIB="\${RANLIB} \$@" MAKE_EXE="\${CC} -o \$@" LIBPREFIX="lib" @@ -3630,9 +3630,8 @@ echo "$as_me: error: ${CC} does not support the -shared option. LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\$@)" @@ -4004,6 +4003,7 @@ _ACEOF RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\$@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\$@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" @@ -5168,6 +5168,19 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" + +# X86|AMD64|IA64 for manifest + + @@ -5235,6 +5248,7 @@ fi + # empty on win, but needs sub'ing @@ -5261,7 +5275,7 @@ fi - ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj" + ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure @@ -5815,6 +5829,7 @@ do "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;; "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;; + "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; @@ -5928,6 +5943,8 @@ s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t +s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t +s,@MACHINE@,$MACHINE,;t t s,@TCL_VERSION@,$TCL_VERSION,;t t s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t @@ -5976,6 +5993,7 @@ s,@LIBSUFFIX@,$LIBSUFFIX,;t t s,@EXESUFFIX@,$EXESUFFIX,;t t s,@LIBRARIES@,$LIBRARIES,;t t s,@MAKE_LIB@,$MAKE_LIB,;t t +s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t s,@MAKE_DLL@,$MAKE_DLL,;t t s,@MAKE_EXE@,$MAKE_EXE,;t t diff --git a/win/configure.in b/win/configure.in index 6e1af50..77e0327 100644 --- a/win/configure.in +++ b/win/configure.in @@ -350,6 +350,19 @@ else TCL_PACKAGE_PATH="${prefix}/lib" fi +# The tclsh.exe.manifest requires these +# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs +# the release level, and must account for interim release versioning +case "$TCL_PATCH_LEVEL" in + *a*) TCL_RELEASE_LEVEL=0 ;; + *b*) TCL_RELEASE_LEVEL=1 ;; + *) TCL_RELEASE_LEVEL=2 ;; +esac +TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`" +AC_SUBST(TCL_WIN_VERSION) +# X86|AMD64|IA64 for manifest +AC_SUBST(MACHINE) + AC_SUBST(TCL_VERSION) AC_SUBST(TCL_MAJOR_VERSION) AC_SUBST(TCL_MINOR_VERSION) @@ -413,6 +426,7 @@ AC_SUBST(LIBSUFFIX) AC_SUBST(EXESUFFIX) AC_SUBST(LIBRARIES) AC_SUBST(MAKE_LIB) +AC_SUBST(MAKE_STUB_LIB) AC_SUBST(POST_MAKE_LIB) AC_SUBST(MAKE_DLL) AC_SUBST(MAKE_EXE) @@ -443,7 +457,7 @@ AC_SUBST(RC_DEFINE) AC_SUBST(RC_DEFINES) AC_SUBST(RES) -AC_OUTPUT(Makefile tclConfig.sh tcl.hpj) +AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest) dnl Local Variables: dnl mode: autoconf; diff --git a/win/makefile.vc b/win/makefile.vc index 09a1135..19b5614 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -623,7 +623,7 @@ $** !endif $(TCLSTUBLIB): $(TCLSTUBOBJS) - $(lib32) -nologo $(LINKERFLAGS) -out:$@ $(TCLSTUBOBJS) + $(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS) $(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB) $(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $** @@ -986,6 +986,12 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c $(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c $(cc32) $(STUB_CFLAGS) -Zl -DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $? +$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in + @nmakehlp -s << $** >$@ +@MACHINE@ $(MACHINE:IX86=X86) +@TCL_WIN_VERSION@ $(TCL_DOTVERSION).0.0 +<< + #--------------------------------------------------------------------- # Generate the source dependencies. Having dependency rules will # improve incremental build accuracy without having to resort to a @@ -1052,12 +1058,14 @@ $< << {$(WINDIR)}.rc{$(TMP_DIR)}.res: - $(rc32) -fo $@ -r -i "$(GENERICDIR)" \ + $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \ -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \ -d TCL_THREADS=$(TCL_THREADS) \ -d STATIC_BUILD=$(STATIC_BUILD) \ $< +$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest + .SUFFIXES: .SUFFIXES:.c .rc @@ -247,7 +247,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [ # # Results: # -# Subst the following vars: +# Substitutes the following vars: # TCL_BIN_DIR # TCL_SRC_DIR # TCL_LIB_FILE @@ -523,6 +523,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ # RES # # MAKE_LIB +# MAKE_STUB_LIB # MAKE_EXE # MAKE_DLL # @@ -634,7 +635,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ if test "${GCC}" = "yes" ; then extra_cflags="-pipe" - extra_ldflags="-pipe" + extra_ldflags="-pipe -static-libgcc" AC_CACHE_CHECK(for mingw32 version of gcc, ac_cv_win32, AC_TRY_COMPILE([ @@ -665,7 +666,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ extra_ldflags="$extra_ldflags -municode" else extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS" - extra_ldflags="$extra_ldflags -static-libgcc" fi fi @@ -683,6 +683,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=--define RES=res.o MAKE_LIB="\${STLIB_LD} \[$]@" + MAKE_STUB_LIB="\${STLIB_LD} \[$]@" POST_MAKE_LIB="\${RANLIB} \[$]@" MAKE_EXE="\${CC} -o \[$]@" LIBPREFIX="lib" @@ -710,9 +711,8 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ LIBRARIES="\${SHARED_LIBRARIES}" fi # Link with gcc since ld does not link to default libs like - # -luser32 and -lmsvcrt by default. Make sure CFLAGS is - # included so -mno-cygwin passed the correct libs to the linker. - SHLIB_LD='${CC} -shared ${CFLAGS}' + # -luser32 and -lmsvcrt by default. + SHLIB_LD='${CC} -shared' SHLIB_LD_LIBS='${LIBS}' MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \ -Wl,--out-implib,\$(patsubst %.dll,lib%.a,\[$]@)" @@ -961,6 +961,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ RC_DEFINE=-d RES=res MAKE_LIB="\${STLIB_LD} -out:\[$]@" + MAKE_STUB_LIB="\${STLIB_LD} -nodefaultlib -out:\[$]@" POST_MAKE_LIB= MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" diff --git a/win/tclAppInit.c b/win/tclAppInit.c index 88699d3..a6c1a67 100644 --- a/win/tclAppInit.c +++ b/win/tclAppInit.c @@ -34,6 +34,7 @@ extern Tcl_PackageInitProc Dde_SafeInit; #endif #ifdef TCL_BROKEN_MAINARGS +int _CRT_glob = 0; static void setargv(int *argcPtr, TCHAR ***argvPtr); #endif /* TCL_BROKEN_MAINARGS */ diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c index 0d3b683..634e1d2 100644 --- a/win/tclWin32Dll.c +++ b/win/tclWin32Dll.c @@ -25,23 +25,6 @@ static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ static int platformId; /* Running under NT, or 95/98? */ -#ifdef HAVE_NO_SEH -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; -#endif - /* * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it */ @@ -198,11 +181,11 @@ void TclWinInit( HINSTANCE hInst) /* Library instance handle. */ { - OSVERSIONINFO os; + OSVERSIONINFOW os; hInstance = hInst; - os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&os); + os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + GetVersionExW(&os); platformId = os.dwPlatformId; /* @@ -662,7 +645,7 @@ TclWinCPUID( # else - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; /* * Execute the CPUID instruction with the given index, and store results @@ -671,7 +654,7 @@ TclWinCPUID( __asm__ __volatile__( /* - * Construct an EXCEPTION_REGISTRATION to protect the CPUID + * Construct an TCLEXCEPTION_REGISTRATION to protect the CPUID * instruction (early 486's don't have CPUID) */ @@ -685,7 +668,7 @@ TclWinCPUID( "movl %[error], 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain + * Link the TCLEXCEPTION_REGISTRATION on the chain */ "movl %%edx, %%fs:0" "\n\t" @@ -704,7 +687,7 @@ TclWinCPUID( "movl %%edx, 0xc(%%edi)" "\n\t" /* - * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and * store a TCL_OK status. */ @@ -714,7 +697,7 @@ TclWinCPUID( "jmp 2f" "\n" /* - * Come here on an exception. Get the EXCEPTION_REGISTRATION that we + * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that we * previously put on the chain. */ @@ -724,7 +707,7 @@ TclWinCPUID( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 52b9e32..21115f7 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -119,23 +119,6 @@ static const Tcl_ChannelType fileChannelType = { FileThreadActionProc, /* Thread action proc. */ FileTruncateProc /* Truncate proc. */ }; - -#ifdef HAVE_NO_SEH -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; -#endif /* *---------------------------------------------------------------------- @@ -1030,7 +1013,7 @@ Tcl_MakeFileChannel( * TCL_WRITABLE to indicate file mode. */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif char channelName[16 + TCL_INTEGER_SPACE]; Tcl_Channel channel = NULL; @@ -1111,7 +1094,7 @@ Tcl_MakeFileChannel( "movl %[dupedHandle], %%ebx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CloseHandle. */ @@ -1125,7 +1108,7 @@ Tcl_MakeFileChannel( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -1138,7 +1121,7 @@ Tcl_MakeFileChannel( "call _CloseHandle@4" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION * and put a TRUE status return into it. */ @@ -1148,7 +1131,7 @@ Tcl_MakeFileChannel( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -1157,7 +1140,7 @@ Tcl_MakeFileChannel( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 65e4aed..0ec22c5 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -800,7 +800,7 @@ ConsoleOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -1079,7 +1079,7 @@ WaitForRead( * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } diff --git a/win/tclWinError.c b/win/tclWinError.c index 49eeed3..4d3250d 100644 --- a/win/tclWinError.c +++ b/win/tclWinError.c @@ -292,7 +292,7 @@ static const unsigned char errorTable[] = { */ static const unsigned char wsaErrorTable[] = { - EAGAIN, /* WSAEWOULDBLOCK */ + EWOULDBLOCK, /* WSAEWOULDBLOCK */ EINPROGRESS, /* WSAEINPROGRESS */ EALREADY, /* WSAEALREADY */ ENOTSOCK, /* WSAENOTSOCK */ diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 0476915..2700cb3 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -67,25 +67,6 @@ const TclFileAttrProcs tclpFileAttrProcs[] = { {GetWinFileShortName, CannotSetAttribute}, {GetWinFileAttributes, SetWinFileAttributes}}; -#ifdef HAVE_NO_SEH - -/* - * Unlike Borland and Microsoft, we don't register exception handlers by - * pushing registration records onto the runtime stack. Instead, we register - * them by creating an EXCEPTION_REGISTRATION within the activation record. - */ - -typedef struct EXCEPTION_REGISTRATION { - struct EXCEPTION_REGISTRATION *link; - EXCEPTION_DISPOSITION (*handler)( - struct _EXCEPTION_RECORD *, void *, struct _CONTEXT *, void *); - void *ebp; - void *esp; - int status; -} EXCEPTION_REGISTRATION; - -#endif - /* * Prototype for the TraverseWinTree callback function. */ @@ -176,7 +157,7 @@ DoRenameFile( * (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif DWORD srcAttr, dstAttr; int retval = -1; @@ -213,7 +194,7 @@ DoRenameFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * MoveFile. */ @@ -227,7 +208,7 @@ DoRenameFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -242,7 +223,7 @@ DoRenameFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from MoveFile into it. */ @@ -251,7 +232,7 @@ DoRenameFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -260,7 +241,7 @@ DoRenameFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" @@ -563,7 +544,7 @@ DoCopyFile( const TCHAR *nativeDst) /* Pathname of file to copy to (native). */ { #if defined(HAVE_NO_SEH) && !defined(_WIN64) - EXCEPTION_REGISTRATION registration; + TCLEXCEPTION_REGISTRATION registration; #endif int retval = -1; @@ -600,7 +581,7 @@ DoCopyFile( "movl %[nativeSrc], %%ecx" "\n\t" /* - * Construct an EXCEPTION_REGISTRATION to protect the call to + * Construct an TCLEXCEPTION_REGISTRATION to protect the call to * CopyFile. */ @@ -614,7 +595,7 @@ DoCopyFile( "movl $0, 0x10(%%edx)" "\n\t" /* status */ /* - * Link the EXCEPTION_REGISTRATION on the chain. + * Link the TCLEXCEPTION_REGISTRATION on the chain. */ "movl %%edx, %%fs:0" "\n\t" @@ -630,7 +611,7 @@ DoCopyFile( "call *%%eax" "\n\t" /* - * Come here on normal exit. Recover the EXCEPTION_REGISTRATION and + * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and * put the status return from CopyFile into it. */ @@ -639,7 +620,7 @@ DoCopyFile( "jmp 2f" "\n" /* - * Come here on an exception. Recover the EXCEPTION_REGISTRATION + * Come here on an exception. Recover the TCLEXCEPTION_REGISTRATION */ "1:" "\t" @@ -648,7 +629,7 @@ DoCopyFile( /* * Come here however we exited. Restore context from the - * EXCEPTION_REGISTRATION in case the stack is unbalanced. + * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced. */ "2:" "\t" diff --git a/win/tclWinInit.c b/win/tclWinInit.c index d82944e..7b027c5 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -530,7 +530,7 @@ TclpSetVariables( SYSTEM_INFO info; OemId oemId; } sys; - OSVERSIONINFOA osInfo; + OSVERSIONINFOW osInfo; Tcl_DString ds; TCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; @@ -538,8 +538,8 @@ TclpSetVariables( Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); - osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - GetVersionExA(&osInfo); + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + GetVersionExW(&osInfo); GetSystemInfo(&sys.info); diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 882b811..c7066bb 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -14,6 +14,23 @@ #include "tclInt.h" +#ifdef HAVE_NO_SEH +/* + * Unlike Borland and Microsoft, we don't register exception handlers by + * pushing registration records onto the runtime stack. Instead, we register + * them by creating an TCLEXCEPTION_REGISTRATION within the activation record. + */ + +typedef struct TCLEXCEPTION_REGISTRATION { + struct TCLEXCEPTION_REGISTRATION *link; + EXCEPTION_DISPOSITION (*handler)( + struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*); + void *ebp; + void *esp; + int status; +} TCLEXCEPTION_REGISTRATION; +#endif + /* * Some versions of Borland C have a define for the OSVERSIONINFO for * Win32s and for NT, but not for Windows 95. diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 13caba9..77fc776 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1884,7 +1884,7 @@ PipeClose2Proc( SetEvent(pipePtr->stopWriter); if (WaitForSingleObject(pipePtr->writable, 0) == WAIT_TIMEOUT) { - return EAGAIN; + return EWOULDBLOCK; } } else { @@ -2161,7 +2161,7 @@ PipeOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error; } @@ -2712,7 +2712,7 @@ WaitForRead( * is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; return -1; } diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index 75d5ffc..b9c9a9f 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -932,7 +932,7 @@ SerialInputProc( bufSize = cStat.cbInQue; } } else { - errno = *errorCode = EAGAIN; + errno = *errorCode = EWOULDBLOCK; return -1; } } else { @@ -1034,7 +1034,7 @@ SerialOutputProc( * the channel is in non-blocking mode. */ - errno = EAGAIN; + errno = EWOULDBLOCK; goto error1; } diff --git a/win/tclWinSock.c b/win/tclWinSock.c index f4d5a90..11b4162 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -1131,10 +1131,9 @@ CreateSocket( int asyncConnect = 0; /* Will be 1 if async connect is in * progress. */ unsigned short chosenport = 0; - void *addrlist = NULL, *myaddrlist = NULL; - struct addrinfo *addrPtr; + struct addrinfo *addrlist = NULL, *addrPtr; /* Socket address to connect to. */ - struct addrinfo *myaddrPtr; + struct addrinfo *myaddrlist = NULL, *myaddrPtr; /* Socket address for our side. */ const char *errorMsg = NULL; SOCKET sock = INVALID_SOCKET; @@ -1317,8 +1316,9 @@ CreateSocket( if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen) == SOCKET_ERROR) { - TclWinConvertError((DWORD) WSAGetLastError()); - if (Tcl_GetErrno() != EAGAIN) { + DWORD error = (DWORD) WSAGetLastError(); + if (error != WSAEWOULDBLOCK) { + TclWinConvertError(error); goto looperror; } @@ -1359,10 +1359,10 @@ CreateSocket( } error: - if (addrlist == NULL) { + if (addrlist != NULL) { freeaddrinfo(addrlist); } - if (myaddrlist == NULL) { + if (myaddrlist != NULL) { freeaddrinfo(myaddrlist); } @@ -1441,7 +1441,7 @@ WaitForSocketEvent( } else if (infoPtr->readyEvents & events) { break; } else if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; result = 0; break; } @@ -1926,7 +1926,7 @@ TcpOutputProc( if (error == WSAEWOULDBLOCK) { infoPtr->readyEvents &= ~(FD_WRITE); if (infoPtr->flags & SOCKET_ASYNC) { - *errorCodePtr = EAGAIN; + *errorCodePtr = EWOULDBLOCK; bytesWritten = -1; break; } diff --git a/win/tclsh.exe.manifest.in b/win/tclsh.exe.manifest.in new file mode 100644 index 0000000..aaa34e1 --- /dev/null +++ b/win/tclsh.exe.manifest.in @@ -0,0 +1,33 @@ +<?xml version="1.0" encoding="UTF-8" standalone="yes"?> +<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0" + xmlns:asmv3="urn:schemas-microsoft-com:asm.v3"> + <assemblyIdentity + version="@TCL_WIN_VERSION@" + processorArchitecture="@MACHINE@" + name="Tcl.tclsh" + type="win32" + /> + <description>Tcl command line shell (tclsh)</description> + <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3"> + <security> + <requestedPrivileges> + <requestedExecutionLevel + level="asInvoker" + uiAccess="false" + /> + </requestedPrivileges> + </security> + </trustInfo> + <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1"> + <application> + <!-- Windows 8.1 --> + <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/> + <!-- Windows 8 --> + <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/> + <!-- Windows 7 --> + <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/> + <!-- Windows Vista --> + <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/> + </application> + </compatibility> +</assembly> diff --git a/win/tclsh.rc b/win/tclsh.rc index 16eaf83..161da50 100644 --- a/win/tclsh.rc +++ b/win/tclsh.rc @@ -1,3 +1,4 @@ +// // Version Resource Script // @@ -67,3 +68,15 @@ END // tclsh ICON DISCARDABLE "tclsh.ico" + +// +// This is needed for Windows 8.1 onwards. +// + +#ifndef RT_MANIFEST +#define RT_MANIFEST 24 +#endif +#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID +#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1 +#endif +CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclsh.exe.manifest" |