summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2018-11-06 09:51:55 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2018-11-06 09:51:55 (GMT)
commit2798a075ee62ea5ab4aa80279d614a8634ba378a (patch)
tree0a09cb9e38547d3b35e396717c0b04302eb5bd8a
parent5429d6aeaf940119a7a7bb0a3d54ae966c234314 (diff)
parentf7dfeb706fb75bccd0aae6cd6119fccdfb6bd8d0 (diff)
downloadtcl-2798a075ee62ea5ab4aa80279d614a8634ba378a.zip
tcl-2798a075ee62ea5ab4aa80279d614a8634ba378a.tar.gz
tcl-2798a075ee62ea5ab4aa80279d614a8634ba378a.tar.bz2
Implement TIP 445
-rw-r--r--[-rwxr-xr-x]compat/zlib/win32/zlib1.dllbin105472 -> 105472 bytes
-rw-r--r--[-rwxr-xr-x]compat/zlib/win64/zlib1.dllbin116736 -> 116736 bytes
-rw-r--r--[-rwxr-xr-x]compat/zlib/zlib2ansi0
-rwxr-xr-x[-rw-r--r--]doc/GetCwd.30
-rwxr-xr-x[-rw-r--r--]doc/GetVersion.30
-rwxr-xr-x[-rw-r--r--]doc/lset.n0
-rw-r--r--generic/tcl.decls18
-rw-r--r--generic/tcl.h45
-rw-r--r--generic/tclAssembly.c20
-rw-r--r--generic/tclBasic.c93
-rw-r--r--generic/tclBinary.c211
-rw-r--r--generic/tclClock.c2
-rw-r--r--generic/tclCmdIL.c18
-rw-r--r--generic/tclCmdMZ.c13
-rw-r--r--generic/tclCompExpr.c8
-rw-r--r--generic/tclCompile.c32
-rw-r--r--generic/tclCompile.h17
-rw-r--r--generic/tclDecls.h29
-rw-r--r--generic/tclDictObj.c222
-rw-r--r--generic/tclDisassemble.c88
-rw-r--r--generic/tclEncoding.c36
-rw-r--r--generic/tclEnsemble.c40
-rw-r--r--generic/tclExecute.c63
-rw-r--r--generic/tclIO.c43
-rw-r--r--generic/tclIndexObj.c74
-rw-r--r--generic/tclInt.h46
-rw-r--r--generic/tclInterp.c2
-rw-r--r--generic/tclLink.c5
-rw-r--r--generic/tclListObj.c249
-rw-r--r--generic/tclNamesp.c65
-rw-r--r--generic/tclOOCall.c29
-rw-r--r--generic/tclOOMethod.c13
-rw-r--r--generic/tclObj.c265
-rw-r--r--generic/tclPathObj.c251
-rw-r--r--generic/tclProc.c179
-rw-r--r--generic/tclRegexp.c60
-rw-r--r--generic/tclScan.c6
-rwxr-xr-x[-rw-r--r--]generic/tclStrToD.c0
-rw-r--r--generic/tclStringObj.c2
-rw-r--r--generic/tclStubInit.c5
-rw-r--r--generic/tclTest.c10
-rw-r--r--generic/tclTimer.c11
-rw-r--r--generic/tclUtil.c30
-rw-r--r--generic/tclVar.c164
-rwxr-xr-x[-rw-r--r--]library/clock.tcl0
-rwxr-xr-x[-rw-r--r--]library/encoding/tis-620.enc0
-rwxr-xr-x[-rw-r--r--]library/msgs/af.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/af_za.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_jo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_lb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_sy.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bn_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/cs.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/da.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de_at.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/el.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_au.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_bw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_hk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ie.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_nz.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ph.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_sg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_za.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_zw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ar.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_bo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_cl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_co.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_cr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_do.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ec.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_gt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_hn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_mx.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ni.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pa.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pe.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_py.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_sv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_uy.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ve.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/et.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eu.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eu_es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa_ir.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fo_fo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_ch.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ga.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ga_ie.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gl_es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gv_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/he.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hi_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hu.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/id.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/id_id.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/is.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/it.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/it_ch.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ja.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kl_gl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ko.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ko_kr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kok.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kok_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kw_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/lt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/lv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mr_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ms.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ms_my.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nl_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pt_br.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ro.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ru.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ru_ua.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sh.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sq.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ta.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ta_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/te.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/te_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/th.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/tr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/uk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/vi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_cn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_hk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_sg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_tw.msg0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Africa/Asmara0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Atikokan0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Blanc-Sablon0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Petersburg0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Tell_City0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Vincennes0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Winamac0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Moncton0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/North_Dakota/New_Salem0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Resolute0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Atlantic/Faroe0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Australia/Eucla0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Guernsey0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Isle_of_Man0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Jersey0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Podgorica0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Volgograd0
-rw-r--r--macosx/tclMacOSXFCmd.c36
-rwxr-xr-x[-rw-r--r--]tests/lsetComp.test0
-rwxr-xr-x[-rw-r--r--]tests/notify.test0
-rw-r--r--tests/obj.test1
-rwxr-xr-x[-rw-r--r--]tools/encoding/ebcdic.txt0
-rwxr-xr-x[-rw-r--r--]tools/encoding/tis-620.txt0
-rw-r--r--unix/tclUnixSock.c15
-rwxr-xr-x[-rw-r--r--]win/buildall.vc.bat0
-rwxr-xr-x[-rw-r--r--]win/tclWinFile.c0
199 files changed, 1545 insertions, 971 deletions
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 3196f4a..3196f4a 100755..100644
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
index 81195c3..81195c3 100755..100644
--- a/compat/zlib/win64/zlib1.dll
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
diff --git a/compat/zlib/zlib2ansi b/compat/zlib/zlib2ansi
index 15e3e16..15e3e16 100755..100644
--- a/compat/zlib/zlib2ansi
+++ b/compat/zlib/zlib2ansi
diff --git a/doc/GetCwd.3 b/doc/GetCwd.3
index f4f37a1..f4f37a1 100644..100755
--- a/doc/GetCwd.3
+++ b/doc/GetCwd.3
diff --git a/doc/GetVersion.3 b/doc/GetVersion.3
index 3672382..3672382 100644..100755
--- a/doc/GetVersion.3
+++ b/doc/GetVersion.3
diff --git a/doc/lset.n b/doc/lset.n
index e425274..e425274 100644..100755
--- a/doc/lset.n
+++ b/doc/lset.n
diff --git a/generic/tcl.decls b/generic/tcl.decls
index dfcb822..0bc43e8 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2346,6 +2346,24 @@ declare 635 {
unsigned char *data, size_t datalen, int copy)
}
+# TIP #445
+declare 636 {
+ void Tcl_FreeIntRep(Tcl_Obj *objPtr)
+}
+declare 637 {
+ char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+ unsigned int numBytes)
+}
+declare 638 {
+ Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
+}
+declare 639 {
+ void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
+ const Tcl_ObjIntRep *irPtr)
+}
+declare 640 {
+ int Tcl_HasStringRep(Tcl_Obj *objPtr)
+}
# ----- BASELINE -- FOR -- 8.7.0 ----- #
##############################################################################
diff --git a/generic/tcl.h b/generic/tcl.h
index 0971066..35edebb 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -751,6 +751,29 @@ typedef struct Tcl_ObjType {
} Tcl_ObjType;
/*
+ * The following structure stores an internal representation (intrep) for
+ * a Tcl value. An intrep is associated with an Tcl_ObjType when both
+ * are stored in the same Tcl_Obj. The routines of the Tcl_ObjType govern
+ * the handling of the intrep.
+ */
+
+typedef union Tcl_ObjIntRep { /* The internal representation: */
+ long longValue; /* - an long integer value. */
+ double doubleValue; /* - a double-precision floating value. */
+ void *otherValuePtr; /* - another, type-specific value, */
+ /* not used internally any more. */
+ Tcl_WideInt wideValue; /* - an integer value >= 64bits */
+ struct { /* - internal rep as two pointers. */
+ void *ptr1;
+ void *ptr2;
+ } twoPtrValue;
+ struct { /* - internal rep as a pointer and a long, */
+ void *ptr; /* not used internally any more. */
+ unsigned long value;
+ } ptrAndLongRep;
+} Tcl_ObjIntRep;
+
+/*
* One of the following structures exists for each object in the Tcl system.
* An object stores a value as either a string, some internal representation,
* or both.
@@ -775,27 +798,7 @@ typedef struct Tcl_Obj {
* corresponds to the type of the object's
* internal rep. NULL indicates the object has
* no internal rep (has no type). */
- union { /* The internal representation: */
- long longValue; /* - an long integer value. */
- double doubleValue; /* - a double-precision floating value. */
- void *otherValuePtr; /* - another, type-specific value, not used
- * internally any more. */
- Tcl_WideInt wideValue; /* - a long long value. */
- struct { /* - internal rep as two pointers.
- * Many uses in Tcl, including a bignum's
- * tightly packed fields, where the alloc,
- * used and signum flags are packed into
- * ptr2 with everything else hung off
- * ptr1. */
- void *ptr1;
- void *ptr2;
- } twoPtrValue;
- struct { /* - internal rep as a pointer and a long,
- * not used internally any more. */
- void *ptr;
- unsigned long value;
- } ptrAndLongRep;
- } internalRep;
+ Tcl_ObjIntRep internalRep; /* The internal representation: */
} Tcl_Obj;
/*
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 6356a00..5ac9a55 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -32,6 +32,7 @@
#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
+#include <assert.h>
/*
* Structure that represents a range of instructions in the bytecode.
@@ -271,15 +272,12 @@ static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src,
- Tcl_Obj* dest);
static void FillInJumpOffsets(AssemblyEnv*);
static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_Obj* jumpTable);
static int FindLocalVar(AssemblyEnv* envPtr,
Tcl_Token** tokenPtrPtr);
static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
static void FreeAssemblyEnv(AssemblyEnv*);
static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -318,6 +316,9 @@ static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
* Tcl_ObjType that describes bytecode emitted by the assembler.
*/
+static Tcl_FreeInternalRepProc FreeAssembleCodeInternalRep;
+static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
+
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
@@ -847,15 +848,15 @@ CompileAssembleObj(
const char* source; /* String representation of the source code */
int sourceLen; /* Length of the source code in bytes */
-
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &assembleCodeType) {
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+
+ if (codePtr) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
@@ -869,7 +870,7 @@ CompileAssembleObj(
* Not valid, so free it and regenerate.
*/
- TclFreeIntRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
}
/*
@@ -4332,7 +4333,10 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+ assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 179306d..75c467b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3867,9 +3867,14 @@ OldMathFuncProc(
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
- if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
- d = valuePtr->internalRep.doubleValue;
- result = TCL_OK;
+ if (result != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr
+ = Tcl_FetchIntRep(valuePtr, &tclDoubleType);
+
+ if (irPtr) {
+ d = irPtr->doubleValue;
+ result = TCL_OK;
+ }
}
#endif
if (result != TCL_OK) {
@@ -6151,7 +6156,7 @@ TclArgumentGet(
* up by the caller. It knows better than us.
*/
- if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+ if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) {
return;
}
@@ -7428,9 +7433,13 @@ ExprCeilFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7464,9 +7473,13 @@ ExprFloorFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7600,9 +7613,13 @@ ExprSqrtFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7643,10 +7660,14 @@ ExprUnaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- d = objv[1]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7703,10 +7724,14 @@ ExprBinaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- d1 = objv[1]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d1 = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7714,10 +7739,14 @@ ExprBinaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
- d2 = objv[2]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d2 = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7754,14 +7783,16 @@ ExprAbsFunc(
if (l > (Tcl_WideInt)0) {
goto unChanged;
} else if (l == (Tcl_WideInt)0) {
- const char *string = objv[1]->bytes;
- if (string) {
- while (*string != '0') {
- if (*string == '-') {
+ if (TclHasStringRep(objv[1])) {
+ int numBytes;
+ const char *bytes = TclGetStringFromObj(objv[1], &numBytes);
+
+ while (numBytes) {
+ if (*bytes == '-') {
Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
return TCL_OK;
}
- string++;
+ bytes++; numBytes--;
}
}
goto unChanged;
@@ -7857,7 +7888,7 @@ ExprDoubleFunc(
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (objv[1]->typePtr == &tclDoubleType) {
+ if (Tcl_FetchIntRep(objv[1], &tclDoubleType)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index fdc60e7..96adff0 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -15,6 +15,7 @@
#include "tommath.h"
#include <math.h>
+#include <assert.h>
/*
* The following constants are used by GetFormatSpec to indicate various
@@ -56,9 +57,12 @@
static void DupByteArrayInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
+static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
static int FormatNumber(Tcl_Interp *interp, int type,
Tcl_Obj *src, unsigned char **cursorPtr);
static void FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int GetFormatSpec(const char **formatPtr, char *cmdPtr,
int *countPtr, int *flagsPtr);
static Tcl_Obj * ScanNumber(unsigned char *buffer, int type,
@@ -246,8 +250,8 @@ static const EnsembleImplMap decodeMap[] = {
static const Tcl_ObjType properByteArrayType = {
"bytearray",
- FreeByteArrayInternalRep,
- DupByteArrayInternalRep,
+ FreeProperByteArrayInternalRep,
+ DupProperByteArrayInternalRep,
UpdateStringOfByteArray,
NULL
};
@@ -268,9 +272,9 @@ const Tcl_ObjType tclByteArrayType = {
*/
typedef struct ByteArray {
- int used; /* The number of bytes used in the byte
+ unsigned int used; /* The number of bytes used in the byte
* array. */
- int allocated; /* The amount of space actually allocated
+ unsigned int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[1]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
@@ -279,16 +283,15 @@ typedef struct ByteArray {
#define BYTEARRAY_SIZE(len) \
((unsigned) (TclOffset(ByteArray, bytes) + (len)))
-#define GET_BYTEARRAY(objPtr) \
- ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
+#define SET_BYTEARRAY(irPtr, baPtr) \
+ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
int
TclIsPureByteArray(
Tcl_Obj * objPtr)
{
- return (objPtr->typePtr == &properByteArrayType);
+ return (NULL != Tcl_FetchIntRep(objPtr, &properByteArrayType));
}
/*
@@ -403,11 +406,11 @@ Tcl_SetByteArrayObj(
be >= 0. */
{
ByteArray *byteArrayPtr;
+ Tcl_ObjIntRep ir;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
- TclFreeIntRep(objPtr);
TclInvalidateStringRep(objPtr);
if (length < 0) {
@@ -420,8 +423,9 @@ Tcl_SetByteArrayObj(
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
}
- objPtr->typePtr = &properByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+
+ Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}
/*
@@ -449,17 +453,24 @@ Tcl_GetByteArrayFromObj(
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
- if ((objPtr->typePtr != &properByteArrayType)
- && (objPtr->typePtr != &tclByteArrayType)) {
- SetByteArrayFromAny(NULL, objPtr);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- baPtr = GET_BYTEARRAY(objPtr);
+ baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
}
- return (unsigned char *) baPtr->bytes;
+ return baPtr->bytes;
}
/*
@@ -490,23 +501,36 @@ Tcl_SetByteArrayLength(
int length) /* New length for internal byte array. */
{
ByteArray *byteArrayPtr;
+ unsigned newLength;
+ Tcl_ObjIntRep *irPtr;
+
+ assert(length >= 0);
+ newLength = (unsigned int)length;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
- if ((objPtr->typePtr != &properByteArrayType)
- && (objPtr->typePtr != &tclByteArrayType)) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- if (length > byteArrayPtr->allocated) {
- byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
- byteArrayPtr->allocated = length;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
+ if (newLength > byteArrayPtr->allocated) {
+ byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
+ byteArrayPtr->allocated = newLength;
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
TclInvalidateStringRep(objPtr);
- byteArrayPtr->used = length;
+ byteArrayPtr->used = newLength;
return byteArrayPtr->bytes;
}
@@ -536,12 +560,12 @@ SetByteArrayFromAny(
const char *src, *srcEnd;
unsigned char *dst;
ByteArray *byteArrayPtr;
- Tcl_UniChar ch = 0;
+ Tcl_ObjIntRep ir;
- if (objPtr->typePtr == &properByteArrayType) {
+ if (Tcl_FetchIntRep(objPtr, &properByteArrayType)) {
return TCL_OK;
}
- if (objPtr->typePtr == &tclByteArrayType) {
+ if (Tcl_FetchIntRep(objPtr, &tclByteArrayType)) {
return TCL_OK;
}
@@ -551,6 +575,7 @@ SetByteArrayFromAny(
byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ Tcl_UniChar ch = 0;
src += TclUtfToUniChar(src, &ch);
improper = improper || (ch > 255);
*dst++ = UCHAR(ch);
@@ -559,9 +584,9 @@ SetByteArrayFromAny(
byteArrayPtr->used = dst - byteArrayPtr->bytes;
byteArrayPtr->allocated = length;
- TclFreeIntRep(objPtr);
- objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+ Tcl_StoreIntRep(objPtr,
+ improper ? &tclByteArrayType : &properByteArrayType, &ir);
return TCL_OK;
}
@@ -586,8 +611,14 @@ static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree(GET_BYTEARRAY(objPtr));
- objPtr->typePtr = NULL;
+ ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &tclByteArrayType)));
+}
+
+static void
+FreeProperByteArrayInternalRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
+{
+ ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &properByteArrayType)));
}
/*
@@ -612,19 +643,41 @@ DupByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- int length;
+ unsigned int length;
+ ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
+
+ srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &tclByteArrayType));
+ length = srcArrayPtr->used;
+
+ copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr->used = length;
+ copyArrayPtr->allocated = length;
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
+
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
+}
+
+static void
+DupProperByteArrayInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
- srcArrayPtr = GET_BYTEARRAY(srcPtr);
+ srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &properByteArrayType));
length = srcArrayPtr->used;
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
- SET_BYTEARRAY(copyPtr, copyArrayPtr);
- copyPtr->typePtr = srcPtr->typePtr;
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
/*
@@ -632,9 +685,7 @@ DupByteArrayInternalRep(
*
* UpdateStringOfByteArray --
*
- * Update the string representation for a ByteArray data object. Note:
- * This procedure does not invalidate an existing old string rep so
- * storage will be lost if this has not already been done.
+ * Update the string representation for a ByteArray data object.
*
* Results:
* None.
@@ -643,9 +694,6 @@ DupByteArrayInternalRep(
* The object's string is set to a valid string that results from the
* ByteArray-to-string conversion.
*
- * The object becomes a string object -- the internal rep is discarded
- * and the typePtr becomes NULL.
- *
*----------------------------------------------------------------------
*/
@@ -654,41 +702,35 @@ UpdateStringOfByteArray(
Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
- int i, length, size;
- unsigned char *src;
- char *dst;
- ByteArray *byteArrayPtr;
-
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- src = byteArrayPtr->bytes;
- length = byteArrayPtr->used;
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
+ unsigned char *src = byteArrayPtr->bytes;
+ unsigned int i, length = byteArrayPtr->used;
+ unsigned int size = length;
/*
* How much space will string rep need?
*/
- size = length;
- for (i = 0; i < length && size >= 0; i++) {
+ for (i = 0; i < length && size <= INT_MAX; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size++;
}
}
- if (size < 0) {
+ if (size > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- dst = ckalloc(size + 1);
- objPtr->bytes = dst;
- objPtr->length = size;
-
if (size == length) {
- memcpy(dst, src, (size_t) size);
- dst[size] = '\0';
+ char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
+ TclOOM(dst, size);
} else {
+ char *dst = Tcl_InitStringRep(objPtr, NULL, size);
+ TclOOM(dst, size);
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
- *dst = '\0';
+ (void)Tcl_InitStringRep(objPtr, NULL, size);
}
}
@@ -718,7 +760,8 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
- int needed;
+ unsigned int length, needed;
+ Tcl_ObjIntRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -731,24 +774,34 @@ TclAppendBytesToByteArray(
/* Append zero bytes is a no-op. */
return;
}
- if ((objPtr->typePtr != &properByteArrayType)
- && (objPtr->typePtr != &tclByteArrayType)) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ length = (unsigned int)len;
+
+ irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
- if (len > INT_MAX - byteArrayPtr->used) {
+ if (length > INT_MAX - byteArrayPtr->used) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- needed = byteArrayPtr->used + len;
+ needed = byteArrayPtr->used + length;
/*
* If we need to, resize the allocated space in the byte array.
*/
if (needed > byteArrayPtr->allocated) {
ByteArray *ptr = NULL;
- int attempt;
+ unsigned int attempt;
if (needed <= INT_MAX/2) {
/* Try to allocate double the total space that is needed. */
@@ -758,7 +811,7 @@ TclAppendBytesToByteArray(
if (ptr == NULL) {
/* Try to allocate double the increment that is needed (plus). */
unsigned int limit = INT_MAX - needed;
- unsigned int extra = len + TCL_MIN_GROWTH;
+ unsigned int extra = length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
@@ -771,13 +824,13 @@ TclAppendBytesToByteArray(
}
byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
if (bytes) {
- memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+ memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length);
}
- byteArrayPtr->used += len;
+ byteArrayPtr->used += length;
TclInvalidateStringRep(objPtr);
}
@@ -1978,10 +2031,11 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType);
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
*cursorPtr += sizeof(double);
@@ -1997,10 +2051,11 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType);
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
/*
diff --git a/generic/tclClock.c b/generic/tclClock.c
index bbfc83b..7f4f592 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -452,7 +452,7 @@ ClockGetdatefieldsObjCmd(
* that it isn't.
*/
- if (objv[1]->typePtr == &tclBignumType) {
+ if (Tcl_FetchIntRep(objv[1], &tclBignumType)) {
Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 434840e..ac2288e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -539,9 +539,9 @@ InfoBodyCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
- const char *name;
+ const char *name, *bytes;
Proc *procPtr;
- Tcl_Obj *bodyPtr, *resultPtr;
+ int numBytes;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "procname");
@@ -566,18 +566,8 @@ InfoBodyCmd(
* the object do not invalidate the internal rep.
*/
- bodyPtr = procPtr->bodyPtr;
- if (bodyPtr->bytes == NULL) {
- /*
- * The string rep might not be valid if the procedure has never been
- * run before. [Bug #545644]
- */
-
- TclGetString(bodyPtr);
- }
- resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-
- Tcl_SetObjResult(interp, resultPtr);
+ bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
return TCL_OK;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f94c094..e113412 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1593,9 +1593,9 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
- if ((objPtr->typePtr == &tclDoubleType) ||
- (objPtr->typePtr == &tclIntType) ||
- (objPtr->typePtr == &tclBignumType)) {
+ if (Tcl_FetchIntRep(objPtr, &tclDoubleType) ||
+ Tcl_FetchIntRep(objPtr, &tclIntType) ||
+ Tcl_FetchIntRep(objPtr, &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1624,8 +1624,8 @@ StringIsCmd(
break;
case STR_IS_INT:
case STR_IS_ENTIER:
- if ((objPtr->typePtr == &tclIntType) ||
- (objPtr->typePtr == &tclBignumType)) {
+ if (Tcl_FetchIntRep(objPtr, &tclIntType) ||
+ Tcl_FetchIntRep(objPtr, &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1903,7 +1903,8 @@ StringMapCmd(
* inconsistencies (see test string-10.20.1 for illustration why!)
*/
- if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
+ if (!TclHasStringRep(objv[objc-2])
+ && Tcl_FetchIntRep(objv[objc-2], &tclDictType)){
int i, done;
Tcl_DictSearch search;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index f8835b9..e96e264 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2476,11 +2476,13 @@ CompileExprTree(
* already, then use it to share via the literal table.
*/
- if (objPtr->bytes) {
+ if (TclHasStringRep(objPtr)) {
Tcl_Obj *tableValue;
+ int numBytes;
+ const char *bytes
+ = Tcl_GetStringFromObj(objPtr, &numBytes);
- index = TclRegisterLiteral(envPtr, objPtr->bytes,
- objPtr->length, 0);
+ index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
tableValue = TclFetchLiteral(envPtr, index);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index b5de230..f6e6b81 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -725,13 +725,14 @@ static const Tcl_ObjType substCodeType = {
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
};
+#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2
/*
* Helper macros.
*/
#define TclIncrUInt4AtPtr(ptr, delta) \
- TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
+ TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr))
/*
*----------------------------------------------------------------------
@@ -974,7 +975,10 @@ static void
FreeByteCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+ assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
@@ -1304,21 +1308,23 @@ CompileSubstObj(
Interp *iPtr = (Interp *) interp;
ByteCode *codePtr = NULL;
- if (objPtr->typePtr == &substCodeType) {
+ ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+
+ if (codePtr != NULL) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
+ if (flags != PTR2INT(SubstFlags(objPtr))
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
|| (codePtr->localCachePtr !=
iPtr->varFramePtr->localCachePtr)) {
- TclFreeIntRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
+ codePtr = NULL;
}
}
- if (objPtr->typePtr != &substCodeType) {
+ if (codePtr == NULL) {
CompileEnv compEnv;
int numBytes;
const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
@@ -1332,8 +1338,7 @@ CompileSubstObj(
codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
- objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
+ SubstFlags(objPtr) = INT2PTR(flags);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1372,7 +1377,10 @@ static void
FreeSubstCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ register ByteCode *codePtr;
+
+ ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+ assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
@@ -2912,9 +2920,7 @@ TclInitByteCodeObj(
* by making its internal rep point to the just compiled ByteCode.
*/
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
- objPtr->typePtr = typePtr;
+ ByteCodeSetIntRep(objPtr, typePtr, codePtr);
return codePtr;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index d827382..3e349b2 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -514,6 +514,23 @@ typedef struct ByteCode {
* created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;
+
+#define ByteCodeSetIntRep(objPtr, typePtr, codePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (codePtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), (typePtr), &ir); \
+ } while (0)
+
+
+
+#define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), (typePtr)); \
+ (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
/*
* Opcodes for the Tcl bytecode instructions. These must correspond to the
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index e20782e..c79a408 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1875,6 +1875,20 @@ EXTERN Tcl_Obj * TclZipfs_TclLibrary(void);
EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp,
const char *mountPoint, unsigned char *data,
size_t datalen, int copy);
+/* 636 */
+EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr);
+/* 637 */
+EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+ unsigned int numBytes);
+/* 638 */
+EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr);
+/* 639 */
+EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr,
+ const Tcl_ObjIntRep *irPtr);
+/* 640 */
+EXTERN int Tcl_HasStringRep(Tcl_Obj *objPtr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -2546,6 +2560,11 @@ typedef struct TclStubs {
int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
+ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */
+ char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
+ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
+ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
+ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -3848,6 +3867,16 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
+#define Tcl_FreeIntRep \
+ (tclStubsPtr->tcl_FreeIntRep) /* 636 */
+#define Tcl_InitStringRep \
+ (tclStubsPtr->tcl_InitStringRep) /* 637 */
+#define Tcl_FetchIntRep \
+ (tclStubsPtr->tcl_FetchIntRep) /* 638 */
+#define Tcl_StoreIntRep \
+ (tclStubsPtr->tcl_StoreIntRep) /* 639 */
+#define Tcl_HasStringRep \
+ (tclStubsPtr->tcl_HasStringRep) /* 640 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 1d952ec..13ff0f8 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -12,6 +12,7 @@
#include "tclInt.h"
#include "tommath.h"
+#include <assert.h>
/*
* Forward declaration.
@@ -149,13 +150,6 @@ typedef struct Dict {
} Dict;
/*
- * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
- * must be assignable as well as readable.
- */
-
-#define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1)
-
-/*
* The structure below defines the dictionary object type by means of
* functions that can be invoked by generic object code.
*/
@@ -168,6 +162,21 @@ const Tcl_ObjType tclDictType = {
SetDictFromAny /* setFromAnyProc */
};
+#define DictSetIntRep(objPtr, dictRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (dictRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclDictType, &ir); \
+ } while (0)
+
+#define DictGetIntRep(objPtr, dictRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &tclDictType); \
+ (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* The type of the specially adapted version of the Tcl_Obj*-containing hash
* table defined in the tclObj.c code. This version differs in that it
@@ -363,10 +372,11 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = DICT(srcPtr);
- Dict *newDict = ckalloc(sizeof(Dict));
+ Dict *oldDict, *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
+ DictGetIntRep(srcPtr, oldDict);
+
/*
* Copy values across from the old hash table.
*/
@@ -398,9 +408,7 @@ DupDictInternalRep(
* Store in the object.
*/
- DICT(copyPtr) = newDict;
- copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- copyPtr->typePtr = &tclDictType;
+ DictSetIntRep(copyPtr, newDict);
}
/*
@@ -425,12 +433,13 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = DICT(dictPtr);
+ Dict *dict;
+
+ DictGetIntRep(dictPtr, dict);
if (dict->refCount-- <= 1) {
DeleteDict(dict);
}
- dictPtr->typePtr = NULL;
}
/*
@@ -489,7 +498,7 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = DICT(dictPtr);
+ Dict *dict;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
@@ -501,12 +510,17 @@ UpdateStringOfDict(
* is not exposed by any API function...
*/
- int numElems = dict->table.numEntries * 2;
+ int numElems;
+
+ DictGetIntRep(dictPtr, dict);
+
+ assert (dict != NULL);
+
+ numElems = dict->table.numEntries * 2;
/* Handle empty list case first, simplifies what follows */
if (numElems == 0) {
- dictPtr->bytes = &tclEmptyString;
- dictPtr->length = 0;
+ Tcl_InitStringRep(dictPtr, NULL, 0);
return;
}
@@ -550,9 +564,8 @@ UpdateStringOfDict(
* Pass 2: copy into string rep buffer.
*/
- dictPtr->length = bytesNeeded - 1;
- dictPtr->bytes = ckalloc(bytesNeeded);
- dst = dictPtr->bytes;
+ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
+ TclOOM(dst, bytesNeeded);
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
@@ -566,7 +579,7 @@ UpdateStringOfDict(
dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
*dst++ = ' ';
}
- dictPtr->bytes[dictPtr->length] = '\0';
+ (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (flagPtr != localFlags) {
ckfree(flagPtr);
@@ -610,7 +623,7 @@ SetDictFromAny(
* the conversion from lists to dictionaries.
*/
- if (objPtr->typePtr == &tclListType) {
+ if (Tcl_FetchIntRep(objPtr, &tclListType)) {
int objc, i;
Tcl_Obj **objv;
@@ -665,10 +678,14 @@ SetDictFromAny(
TclNewStringObj(keyPtr, elemStart, elemSize);
} else {
/* Avoid double copy */
+ char *dst;
+
TclNewObj(keyPtr);
- keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
- keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
- keyPtr->bytes);
+ Tcl_InvalidateStringRep(keyPtr);
+ dst = Tcl_InitStringRep(keyPtr, NULL, elemSize);
+ TclOOM(dst, elemSize); /* Consider error */
+ (void)Tcl_InitStringRep(keyPtr, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, dst));
}
if (TclFindDictElement(interp, nextElem, (limit - nextElem),
@@ -681,10 +698,14 @@ SetDictFromAny(
TclNewStringObj(valuePtr, elemStart, elemSize);
} else {
/* Avoid double copy */
+ char *dst;
+
TclNewObj(valuePtr);
- valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
- valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
- valuePtr->bytes);
+ Tcl_InvalidateStringRep(valuePtr);
+ dst = Tcl_InitStringRep(valuePtr, NULL, elemSize);
+ TclOOM(dst, elemSize); /* Consider error */
+ (void)Tcl_InitStringRep(valuePtr, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, dst));
}
/* Store key and value in the hash table we're building. */
@@ -706,13 +727,10 @@ SetDictFromAny(
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- TclFreeIntRep(objPtr);
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(objPtr) = dict;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclDictType;
+ DictSetIntRep(objPtr, dict);
return TCL_OK;
missingValue:
@@ -726,6 +744,23 @@ SetDictFromAny(
ckfree(dict);
return TCL_ERROR;
}
+
+static Dict *
+GetDictFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr)
+{
+ Dict *dict;
+
+ DictGetIntRep(dictPtr, dict);
+ if (dict == NULL) {
+ if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+ DictGetIntRep(dictPtr, dict);
+ }
+ return dict;
+}
/*
*----------------------------------------------------------------------
@@ -770,11 +805,13 @@ TclTraceDictPath(
Dict *dict, *newDict;
int i;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
- return NULL;
+ DictGetIntRep(dictPtr, dict);
+ if (dict == NULL) {
+ if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+ DictGetIntRep(dictPtr, dict);
}
- dict = DICT(dictPtr);
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -810,13 +847,17 @@ TclTraceDictPath(
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = Tcl_GetHashValue(hPtr);
- if (tmpObj->typePtr != &tclDictType
- && SetDictFromAny(interp, tmpObj) != TCL_OK) {
- return NULL;
+
+ DictGetIntRep(tmpObj, newDict);
+
+ if (newDict == NULL) {
+ if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
+ return NULL;
+ }
}
}
- newDict = DICT(tmpObj);
+ DictGetIntRep(tmpObj, newDict);
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -824,7 +865,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = DICT(tmpObj);
+ DictGetIntRep(tmpObj, newDict);
}
newDict->chain = dictPtr;
@@ -859,17 +900,24 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = DICT(dictObj);
+ Dict *dict;
+
+ DictGetIntRep(dictObj, dict);
+ assert( dict != NULL);
do {
+ dict->refCount++;
TclInvalidateStringRep(dictObj);
+ TclFreeIntRep(dictObj);
+ DictSetIntRep(dictObj, dict);
+
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
- dict = DICT(dictObj);
+ DictGetIntRep(dictObj, dict);
} while (dict != NULL);
}
@@ -907,16 +955,16 @@ Tcl_DictObjPut(
Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
}
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
- dict = DICT(dictPtr);
+ TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+ dict->refCount++;
+ TclFreeIntRep(dictPtr)
+ DictSetIntRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
@@ -958,13 +1006,12 @@ Tcl_DictObjGet(
Dict *dict;
Tcl_HashEntry *hPtr;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
*valuePtrPtr = NULL;
return TCL_ERROR;
}
- dict = DICT(dictPtr);
hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
@@ -1005,16 +1052,13 @@ Tcl_DictObjRemove(
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
}
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
if (DeleteChainEntry(dict, keyPtr)) {
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
dict->epoch++;
}
return TCL_OK;
@@ -1046,12 +1090,11 @@ Tcl_DictObjSize(
{
Dict *dict;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1098,12 +1141,11 @@ Tcl_DictObjFirst(
Dict *dict;
ChainEntry *cPtr;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
searchPtr->epoch = 0;
@@ -1277,7 +1319,8 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = DICT(dictPtr);
+ DictGetIntRep(dictPtr, dict);
+ assert(dict != NULL);
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -1334,7 +1377,8 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = DICT(dictPtr);
+ DictGetIntRep(dictPtr, dict);
+ assert(dict != NULL);
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1380,9 +1424,7 @@ Tcl_NewDictObj(void)
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(dictPtr) = dict;
- dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
- dictPtr->typePtr = &tclDictType;
+ DictSetIntRep(dictPtr, dict);
return dictPtr;
#endif
}
@@ -1430,9 +1472,7 @@ Tcl_DbNewDictObj(
dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(dictPtr) = dict;
- dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
- dictPtr->typePtr = &tclDictType;
+ DictSetIntRep(dictPtr, dict);
return dictPtr;
#else /* !TCL_MEM_DEBUG */
return Tcl_NewDictObj();
@@ -1618,16 +1658,13 @@ DictReplaceCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ if (GetDictFromObj(interp, dictPtr) == NULL) {
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
for (i=2 ; i<objc ; i+=2) {
Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
}
@@ -1669,16 +1706,13 @@ DictRemoveCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ if (GetDictFromObj(interp, dictPtr) == NULL) {
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
for (i=2 ; i<objc ; i++) {
Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
}
@@ -1729,8 +1763,7 @@ DictMergeCmd(
*/
targetObj = objv[1];
- if (targetObj->typePtr != &tclDictType
- && SetDictFromAny(interp, targetObj) != TCL_OK) {
+ if (GetDictFromObj(interp, targetObj) == NULL) {
return TCL_ERROR;
}
@@ -1813,8 +1846,7 @@ DictKeysCmd(
* need. [Bug 1705778, leak K04]
*/
- if (objv[1]->typePtr != &tclDictType
- && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+ if (GetDictFromObj(interp, objv[1]) == NULL) {
return TCL_ERROR;
}
@@ -2021,7 +2053,6 @@ DictInfoCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *dictPtr;
Dict *dict;
char *statsStr;
@@ -2030,12 +2061,10 @@ DictInfoCmd(
return TCL_ERROR;
}
- dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, objv[1]);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
statsStr = Tcl_HashStats(&dict->table);
Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2096,12 +2125,11 @@ DictIncrCmd(
* soon be no good.
*/
- char *saved = dictPtr->bytes;
Tcl_Obj *oldPtr = dictPtr;
- dictPtr->bytes = NULL;
- dictPtr = Tcl_DuplicateObj(dictPtr);
- oldPtr->bytes = saved;
+ TclNewObj(dictPtr);
+ TclInvalidateStringRep(dictPtr);
+ DupDictInternalRep(oldPtr, dictPtr);
}
if (valuePtr == NULL) {
/*
@@ -2238,7 +2266,7 @@ DictLappendCmd(
if (allocatedValue) {
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
- } else if (dictPtr->bytes != NULL) {
+ } else {
TclInvalidateStringRep(dictPtr);
}
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 6580d59..6ea3397 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -38,7 +38,7 @@ static void UpdateStringOfInstName(Tcl_Obj *objPtr);
* reporting of inner contexts in errorstack without string allocation.
*/
-static const Tcl_ObjType tclInstNameType = {
+static const Tcl_ObjType instNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
@@ -46,12 +46,21 @@ static const Tcl_ObjType tclInstNameType = {
NULL, /* setFromAnyProc */
};
-/*
- * How to get the bytecode out of a Tcl_Obj.
- */
+#define InstNameSetIntRep(objPtr, inst) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.wideValue = (inst); \
+ Tcl_StoreIntRep((objPtr), &instNameType, &ir); \
+ } while (0)
+
+#define InstNameGetIntRep(objPtr, inst) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &instNameType); \
+ assert(irPtr != NULL); \
+ (inst) = (size_t)irPtr->wideValue; \
+ } while (0)
-#define BYTECODE(objPtr) \
- ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
/*
*----------------------------------------------------------------------
@@ -245,14 +254,18 @@ DisassembleByteCodeObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- ByteCode *codePtr = BYTECODE(objPtr);
+ ByteCode *codePtr;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
- Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
+ iPtr = (Interp *) *codePtr->interpHandle;
+
TclNewObj(bufferObj);
if (!codePtr->refCount) {
return bufferObj; /* Already freed. */
@@ -796,9 +809,8 @@ TclNewInstNameObj(
{
Tcl_Obj *objPtr = Tcl_NewObj();
- objPtr->typePtr = &tclInstNameType;
- objPtr->internalRep.wideValue = (long) inst;
- objPtr->bytes = NULL;
+ TclInvalidateStringRep(objPtr);
+ InstNameSetIntRep(objPtr, (long) inst);
return objPtr;
}
@@ -817,20 +829,22 @@ static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
- size_t len, inst = (size_t)objPtr->internalRep.wideValue;
- char *s, buf[TCL_INTEGER_SPACE + 5];
+ size_t inst; /* NOTE: We know this is really an unsigned char */
+ char *dst;
+
+ InstNameGetIntRep(objPtr, inst);
if (inst > LAST_INST_OPCODE) {
- sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
- s = buf;
+ dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
+ TclOOM(dst, TCL_INTEGER_SPACE + 5);
+ sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst);
+ (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
} else {
- s = (char *) tclInstructionTable[inst].name;
+ const char *s = tclInstructionTable[inst].name;
+ unsigned int len = strlen(s);
+ dst = Tcl_InitStringRep(objPtr, s, len);
+ TclOOM(dst, len);
}
- len = strlen(s);
- /* assert (len < UINT_MAX) */
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, s, len + 1);
- objPtr->length = len;
}
/*
@@ -942,13 +956,15 @@ DisassembleByteCodeAsDicts(
* procedure, if one exists. */
Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
{
- ByteCode *codePtr = BYTECODE(objPtr);
+ ByteCode *codePtr;
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
/*
* Get the literals from the bytecode.
*/
@@ -1286,6 +1302,7 @@ Tcl_DisassembleObjCmd(
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Object *oPtr;
+ ByteCode *codePtr;
Method *methodPtr;
if (objc < 2) {
@@ -1304,27 +1321,19 @@ Tcl_DisassembleObjCmd(
/*
* Compile (if uncompiled) and disassemble a lambda term.
- *
- * WARNING! Pokes inside the lambda objtype.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
return TCL_ERROR;
}
- if (objv[2]->typePtr == &tclLambdaType) {
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
- }
- if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
- result = tclLambdaType.setFromAnyProc(interp, objv[2]);
- if (result != TCL_OK) {
- return result;
- }
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+
+ procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr);
+ if (procPtr == NULL) {
+ return TCL_ERROR;
}
memset(&cmd, 0, sizeof(Command));
- nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return result;
@@ -1374,8 +1383,9 @@ Tcl_DisassembleObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
- if ((objv[2]->typePtr != &tclByteCodeType)
- && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+
+ if ((NULL == Tcl_FetchIntRep(objv[2], &tclByteCodeType)) && (TCL_OK
+ != TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
return TCL_ERROR;
}
codeObjPtr = objv[2];
@@ -1575,7 +1585,7 @@ Tcl_DisassembleObjCmd(
"METHODTYPE", NULL);
return TCL_ERROR;
}
- if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ if (NULL == Tcl_FetchIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
@@ -1603,7 +1613,9 @@ Tcl_DisassembleObjCmd(
* Do the actual disassembly.
*/
- if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
+ ByteCodeGetIntRep(codeObjPtr, &tclByteCodeType, codePtr);
+
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index d5e8c9a..6d32676 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -279,6 +279,21 @@ static int Iso88591ToUtfProc(ClientData clientData,
static const Tcl_ObjType encodingType = {
"encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
};
+#define EncodingSetIntRep(objPtr, encoding) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (encoding); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &encodingType, &ir); \
+ } while (0)
+
+#define EncodingGetIntRep(objPtr, encoding) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep ((objPtr), &encodingType); \
+ (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -305,17 +320,16 @@ Tcl_GetEncodingFromObj(
Tcl_Obj *objPtr,
Tcl_Encoding *encodingPtr)
{
+ Tcl_Encoding encoding;
const char *name = TclGetString(objPtr);
- if (objPtr->typePtr != &encodingType) {
- Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
-
+ EncodingGetIntRep(objPtr, encoding);
+ if (encoding == NULL) {
+ encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
return TCL_ERROR;
}
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = encoding;
- objPtr->typePtr = &encodingType;
+ EncodingSetIntRep(objPtr, encoding);
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
return TCL_OK;
@@ -335,8 +349,10 @@ static void
FreeEncodingIntRep(
Tcl_Obj *objPtr)
{
- Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
- objPtr->typePtr = NULL;
+ Tcl_Encoding encoding;
+
+ EncodingGetIntRep(objPtr, encoding);
+ Tcl_FreeEncoding(encoding);
}
/*
@@ -354,8 +370,8 @@ DupEncodingIntRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
- dupPtr->typePtr = &encodingType;
+ Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr));
+ EncodingSetIntRep(dupPtr, encoding);
}
/*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 84ed9e3..b710399 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -84,6 +84,21 @@ static const Tcl_ObjType ensembleCmdType = {
NULL /* setFromAnyProc */
};
+#define ECRSetIntRep(objPtr, ecRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (ecRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir); \
+ } while (0)
+
+#define ECRGetIntRep(objPtr, ecRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &ensembleCmdType); \
+ (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* The internal rep for caching ensemble subcommand lookups and spelling
* corrections.
@@ -1742,10 +1757,10 @@ NsEnsembleImplementationCmdNR(
* check here, and if we're still valid, we can jump straight to the
* part where we do the invocation of the subcommand.
*/
+ EnsembleCmdRep *ensembleCmd;
- if (subObj->typePtr==&ensembleCmdType){
- EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
-
+ ECRGetIntRep(subObj, ensembleCmd);
+ if (ensembleCmd) {
if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == (Command *)ensemblePtr->token) {
prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
@@ -2378,8 +2393,8 @@ MakeCachedEnsembleCommand(
{
register EnsembleCmdRep *ensembleCmd;
- if (objPtr->typePtr == &ensembleCmdType) {
- ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ ECRGetIntRep(objPtr, ensembleCmd);
+ if (ensembleCmd) {
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
@@ -2390,10 +2405,8 @@ MakeCachedEnsembleCommand(
* our own.
*/
- TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
- objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
- objPtr->typePtr = &ensembleCmdType;
+ ECRSetIntRep(objPtr, ensembleCmd);
}
/*
@@ -2797,14 +2810,14 @@ static void
FreeEnsembleCmdRep(
Tcl_Obj *objPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ EnsembleCmdRep *ensembleCmd;
+ ECRGetIntRep(objPtr, ensembleCmd);
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
ckfree(ensembleCmd);
- objPtr->typePtr = NULL;
}
/*
@@ -2830,11 +2843,12 @@ DupEnsembleCmdRep(
Tcl_Obj *objPtr,
Tcl_Obj *copyPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ EnsembleCmdRep *ensembleCmd;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
- copyPtr->typePtr = &ensembleCmdType;
- copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+ ECRGetIntRep(objPtr, ensembleCmd);
+ ECRSetIntRep(copyPtr, ensembleCopy);
+
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
ensembleCopy->token->refCount++;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7355bc1..f38f7cd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -748,20 +748,22 @@ ReleaseDictIterator(
{
Tcl_DictSearch *searchPtr;
Tcl_Obj *dictPtr;
+ const Tcl_ObjIntRep *irPtr;
+
+ irPtr = Tcl_FetchIntRep(objPtr, &dictIteratorType);
+ assert(irPtr != NULL);
/*
* First kill the search, and then release the reference to the dictionary
* that we were holding.
*/
- searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ searchPtr = irPtr->twoPtrValue.ptr1;
Tcl_DictObjDone(searchPtr);
ckfree(searchPtr);
- dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ dictPtr = irPtr->twoPtrValue.ptr2;
TclDecrRefCount(dictPtr);
-
- objPtr->typePtr = NULL;
}
/*
@@ -1450,19 +1452,23 @@ CompileExprObj(
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &exprCodeType) {
+
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+
+ if (codePtr != NULL) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
- TclFreeIntRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &exprCodeType, NULL);
+ codePtr = NULL;
}
}
- if (objPtr->typePtr != &exprCodeType) {
+
+ if (codePtr == NULL) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
*/
@@ -1562,7 +1568,9 @@ static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+ assert(codePtr != NULL);
TclReleaseByteCode(codePtr);
}
@@ -1600,7 +1608,8 @@ TclCompileObj(
* compilation). Otherwise, check that it is "fresh" enough.
*/
- if (objPtr->typePtr == &tclByteCodeType) {
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+ if (codePtr != NULL) {
/*
* Make sure the Bytecode hasn't been invalidated by, e.g., someone
* redefining a command with a compile procedure (this might make the
@@ -1618,7 +1627,6 @@ TclCompileObj(
* here.
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1746,7 +1754,7 @@ TclCompileObj(
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -4760,7 +4768,7 @@ TEBCresume(
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
- && (value2Ptr->typePtr != &tclListType)
+ && (NULL == Tcl_FetchIntRep(value2Ptr, &tclListType))
&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
&index) == TCL_OK)) {
TclDecrRefCount(value2Ptr);
@@ -7104,13 +7112,16 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclNewObj(statePtr);
- statePtr->typePtr = &dictIteratorType;
- statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
- statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+ {
+ Tcl_ObjIntRep ir;
+ TclNewObj(statePtr);
+ ir.twoPtrValue.ptr1 = searchPtr;
+ ir.twoPtrValue.ptr2 = dictPtr;
+ Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
+ }
varPtr = LOCAL(opnd);
if (varPtr->value.objPtr) {
- if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+ if (Tcl_FetchIntRep(varPtr->value.objPtr, &dictIteratorType)) {
Tcl_Panic("mis-issued dictFirst!");
}
TclDecrRefCount(varPtr->value.objPtr);
@@ -7123,11 +7134,17 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
statePtr = (*LOCAL(opnd)).value.objPtr;
- if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
- Tcl_Panic("mis-issued dictNext!");
+ {
+ const Tcl_ObjIntRep *irPtr;
+
+ if (statePtr &&
+ (irPtr = Tcl_FetchIntRep(statePtr, &dictIteratorType))) {
+ searchPtr = irPtr->twoPtrValue.ptr1;
+ Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+ } else {
+ Tcl_Panic("mis-issued dictNext!");
+ }
}
- searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
- Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
pushDictIteratorResult:
if (done) {
TclNewObj(emptyPtr);
@@ -9758,7 +9775,7 @@ EvalStatsCmd(
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
- if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
+ if (NULL != Tcl_FetchIntRep(entryPtr->objPtr, &tclByteCodeType)) {
numByteCodeLits++;
}
(void) TclGetStringFromObj(entryPtr->objPtr, &length);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 10362d4..d144cbc 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -337,6 +337,22 @@ static const Tcl_ObjType chanObjType = {
NULL /* setFromAnyProc */
};
+#define ChanSetIntRep(objPtr, resPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (resPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (resPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &chanObjType, &ir); \
+ } while (0)
+
+#define ChanGetIntRep(objPtr, resPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &chanObjType); \
+ (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -1515,12 +1531,12 @@ TclGetChannelFromObj(
return TCL_ERROR;
}
- if (objPtr->typePtr == &chanObjType) {
+ ChanGetIntRep(objPtr, resPtr);
+ if (resPtr) {
/*
* Confirm validity of saved lookup results.
*/
- resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
statePtr = resPtr->statePtr;
if ((resPtr->interp == interp) /* Same interp context */
/* No epoch change in channel since lookup */
@@ -1537,7 +1553,7 @@ TclGetChannelFromObj(
if (chan == NULL) {
if (resPtr) {
- FreeChannelIntRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &chanObjType, NULL);
}
return TCL_ERROR;
}
@@ -1548,14 +1564,10 @@ TclGetChannelFromObj(
*/
Tcl_Release((ClientData) resPtr->statePtr);
-
} else {
- TclFreeIntRep(objPtr);
-
resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
- resPtr->refCount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
- objPtr->typePtr = &chanObjType;
+ resPtr->refCount = 0;
+ ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */
}
statePtr = ((Channel *)chan)->state;
resPtr->statePtr = statePtr;
@@ -11198,11 +11210,11 @@ DupChannelIntRep(
register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
- ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedChanName *resPtr;
- resPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- copyPtr->typePtr = srcPtr->typePtr;
+ ChanGetIntRep(srcPtr, resPtr);
+ assert(resPtr);
+ ChanSetIntRep(copyPtr, resPtr);
}
/*
@@ -11225,9 +11237,10 @@ static void
FreeChannelIntRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedChanName *resPtr;
- objPtr->typePtr = NULL;
+ ChanGetIntRep(objPtr, resPtr);
+ assert(resPtr);
if (resPtr->refCount-- > 1) {
return;
}
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index eeed0e5..c39c0dc 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -115,14 +115,18 @@ Tcl_GetIndexFromObj(
int flags, /* 0 or TCL_EXACT */
int *indexPtr) /* Place to store resulting integer index. */
{
+ if (!(flags & INDEX_TEMP_TABLE)) {
+
/*
* See if there is a valid cached result from a previous lookup (doing the
* check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
* the common case where the result is cached).
*/
- if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
- IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+
+ if (irPtr) {
+ IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
/*
* Here's hoping we don't get hit by unfortunate packing constraints
@@ -135,6 +139,7 @@ Tcl_GetIndexFromObj(
return TCL_OK;
}
}
+ }
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
msg, flags, indexPtr);
}
@@ -266,6 +271,7 @@ Tcl_GetIndexFromObjStruct(
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
+ const Tcl_ObjIntRep *irPtr;
/* Protect against invalid values, like -1 or 0. */
if (offset < (int)sizeof(char *)) {
@@ -275,13 +281,16 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ if (!(flags & INDEX_TEMP_TABLE)) {
+ irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = irPtr->twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
*indexPtr = indexRep->index;
return TCL_OK;
}
}
+ }
/*
* Lookup the value of the object in the table. Accept unique
@@ -337,17 +346,19 @@ Tcl_GetIndexFromObjStruct(
*/
if (!(flags & INDEX_TEMP_TABLE)) {
- if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
- } else {
- TclFreeIntRep(objPtr);
- indexRep = ckalloc(sizeof(IndexRep));
- objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- objPtr->typePtr = &indexType;
- }
- indexRep->tablePtr = (void *) tablePtr;
- indexRep->offset = offset;
- indexRep->index = index;
+ irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = irPtr->twoPtrValue.ptr1;
+ } else {
+ Tcl_ObjIntRep ir;
+
+ indexRep = ckalloc(sizeof(IndexRep));
+ ir.twoPtrValue.ptr1 = indexRep;
+ Tcl_StoreIntRep(objPtr, &indexType, &ir);
+ }
+ indexRep->tablePtr = (void *) tablePtr;
+ indexRep->offset = offset;
+ indexRep->index = index;
}
*indexPtr = index;
@@ -446,16 +457,10 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
- IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
- register char *buf;
- register unsigned len;
+ IndexRep *indexRep = Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
register const char *indexStr = EXPAND_OF(indexRep);
- len = strlen(indexStr);
- buf = ckalloc(len + 1);
- memcpy(buf, indexStr, len+1);
- objPtr->bytes = buf;
- objPtr->length = len;
+ Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
}
/*
@@ -481,12 +486,14 @@ DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_ObjIntRep ir;
IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
- memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
- dupPtr->typePtr = &indexType;
+ memcpy(dupIndexRep, Tcl_FetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+ sizeof(IndexRep));
+
+ ir.twoPtrValue.ptr1 = dupIndexRep;
+ Tcl_StoreIntRep(dupPtr, &indexType, &ir);
}
/*
@@ -510,7 +517,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ ckfree(Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -957,10 +964,10 @@ Tcl_WrongNumArgs(
/*
* Add the element, quoting it if necessary.
*/
+ const Tcl_ObjIntRep *irPtr;
- if (origObjv[i]->typePtr == &indexType) {
- register IndexRep *indexRep =
- origObjv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = Tcl_FetchIntRep(origObjv[i], &indexType))) {
+ register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
@@ -1007,9 +1014,10 @@ Tcl_WrongNumArgs(
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
+ const Tcl_ObjIntRep *irPtr;
- if (objv[i]->typePtr == &indexType) {
- register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = Tcl_FetchIntRep(objv[i], &indexType))) {
+ register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
} else {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index abf6c83..453c10f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2364,6 +2364,13 @@ typedef struct Interp {
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
/*
+ * A common panic alert when memory allocation fails.
+ */
+
+#define TclOOM(ptr, size) \
+ ((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1)))
+
+/*
* The following enum values are used to specify the runtime platform setting
* of the tclPlatform variable.
*/
@@ -2437,12 +2444,6 @@ typedef struct List {
#define ListRepPtr(listPtr) \
((List *) (listPtr)->internalRep.twoPtrValue.ptr1)
-#define ListSetIntRep(objPtr, listRepPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
- (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
- (listRepPtr)->refCount++, \
- (objPtr)->typePtr = &tclListType
-
#define ListObjGetElements(listPtr, objc, objv) \
((objv) = &(ListRepPtr(listPtr)->elements), \
(objc) = ListRepPtr(listPtr)->elemCount)
@@ -2750,7 +2751,6 @@ MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
-MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
@@ -3030,6 +3030,8 @@ MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
Tcl_Obj *value, int *code);
+MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, ClientData *clientDataPtr,
int *typePtr);
@@ -4421,7 +4423,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
- memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
+ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (unsigned) (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
@@ -4483,6 +4485,18 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
/*
*----------------------------------------------------------------
+ * Macro used by the Tcl core to test whether an object has a
+ * string representation (or is a 'pure' internal value).
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclHasStringRep(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)
+
+/*
+ *----------------------------------------------------------------
* Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
* growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
* "prototype" for this macro is:
@@ -4700,18 +4714,18 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
#define TclSetIntObj(objPtr, i) \
do { \
+ Tcl_ObjIntRep ir; \
+ ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
- (objPtr)->typePtr = &tclIntType; \
+ Tcl_StoreIntRep(objPtr, &tclIntType, &ir); \
} while (0)
#define TclSetDoubleObj(objPtr, d) \
- do { \
- TclInvalidateStringRep(objPtr); \
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType; \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.doubleValue = (double) d; \
+ TclInvalidateStringRep(objPtr); \
+ Tcl_StoreIntRep(objPtr, &tclDoubleType, &ir); \
} while (0)
/*
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 1e75298..b1cc0c8 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1826,7 +1826,7 @@ AliasNRCmd(
cmdc = prefc + objc - 1;
listPtr = Tcl_NewListObj(cmdc, NULL);
- listRep = listPtr->internalRep.twoPtrValue.ptr1;
+ listRep = ListRepPtr(listPtr);
listRep->elemCount = cmdc;
cmdv = &listRep->elements;
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 53187d7..952df4e 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -416,7 +416,8 @@ LinkTraceProc(
case TCL_LINK_DOUBLE:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (valueObj->typePtr != &tclDoubleType) {
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(valueObj, &tclDoubleType);
+ if (irPtr == NULL) {
#endif
if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -425,7 +426,7 @@ LinkTraceProc(
}
#ifdef ACCEPT_NAN
}
- linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+ linkPtr->lastValue.d = irPtr->doubleValue;
#endif
}
LinkedVar(double) = linkPtr->lastValue.d;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 8314306..2078989 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -12,6 +12,7 @@
*/
#include "tclInt.h"
+#include <assert.h>
/*
* Prototypes for functions defined later in this file:
@@ -46,6 +47,27 @@ const Tcl_ObjType tclListType = {
SetListFromAny /* setFromAnyProc */
};
+/* Macros to manipulate the List internal rep */
+
+#define ListSetIntRep(objPtr, listRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (listRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ (listRepPtr)->refCount++; \
+ Tcl_StoreIntRep((objPtr), &tclListType, &ir); \
+ } while (0)
+
+#define ListGetIntRep(objPtr, listRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &tclListType); \
+ (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
+#define ListResetIntRep(objPtr, listRepPtr) \
+ Tcl_FetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)
+
#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif
@@ -374,8 +396,7 @@ Tcl_SetListObj(
listRepPtr = NewListIntRep(objc, objv, 1);
ListSetIntRep(objPtr, listRepPtr);
} else {
- objPtr->bytes = &tclEmptyString;
- objPtr->length = 0;
+ Tcl_InitStringRep(objPtr, NULL, 0);
}
}
@@ -407,8 +428,10 @@ TclListObjCopy(
* to be returned. */
{
Tcl_Obj *copyPtr;
+ List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (NULL == listRepPtr) {
if (SetListFromAny(interp, listPtr) != TCL_OK) {
return NULL;
}
@@ -543,10 +566,13 @@ Tcl_ListObjGetElements(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
+
+ if (listRepPtr == NULL) {
+ int result, length;
- if (listPtr->bytes == &tclEmptyString) {
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
@@ -555,8 +581,8 @@ Tcl_ListObjGetElements(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
*objcPtr = listRepPtr->elemCount;
*objvPtr = &listRepPtr->elements;
return TCL_OK;
@@ -653,10 +679,13 @@ Tcl_ListObjAppendElement(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
- if (listPtr->typePtr != &tclListType) {
- int result;
- if (listPtr->bytes == &tclEmptyString) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
@@ -664,9 +693,9 @@ Tcl_ListObjAppendElement(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
needGrow = (numRequired > listRepPtr->maxElemCount);
@@ -762,7 +791,11 @@ Tcl_ListObjAppendElement(
}
listRepPtr = newPtr;
}
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
/*
* Add objPtr to the end of listPtr's array of element pointers. Increment
@@ -817,10 +850,12 @@ Tcl_ListObjIndex(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
- if (listPtr->bytes == &tclEmptyString) {
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*objPtrPtr = NULL;
return TCL_OK;
}
@@ -828,9 +863,9 @@ Tcl_ListObjIndex(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
@@ -870,10 +905,12 @@ Tcl_ListObjLength(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
- if (listPtr->bytes == &tclEmptyString) {
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*intPtr = 0;
return TCL_OK;
}
@@ -881,9 +918,9 @@ Tcl_ListObjLength(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
@@ -943,9 +980,14 @@ Tcl_ListObjReplace(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
- if (listPtr->typePtr != &tclListType) {
- if (listPtr->bytes == &tclEmptyString) {
- if (!objc) {
+
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
+ if (objc == 0) {
return TCL_OK;
}
Tcl_SetListObj(listPtr, objc, NULL);
@@ -956,6 +998,7 @@ Tcl_ListObjReplace(
return result;
}
}
+ ListGetIntRep(listPtr, listRepPtr);
}
/*
@@ -966,7 +1009,6 @@ Tcl_ListObjReplace(
* Resist any temptation to optimize this case.
*/
- listRepPtr = ListRepPtr(listPtr);
elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
@@ -1020,7 +1062,7 @@ Tcl_ListObjReplace(
}
if (newPtr) {
listRepPtr = newPtr;
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
elemPtrs = &listRepPtr->elements;
listRepPtr->maxElemCount = attempt;
needGrow = numRequired > listRepPtr->maxElemCount;
@@ -1093,7 +1135,7 @@ Tcl_ListObjReplace(
}
}
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -1166,10 +1208,15 @@ Tcl_ListObjReplace(
listRepPtr->elemCount = numRequired;
/*
- * Invalidate and free any old string representation since it no longer
- * reflects the list's internal representation.
+ * Invalidate and free any old representations that may not agree
+ * with the revised list's internal representation.
*/
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
+
TclInvalidateStringRep(listPtr);
return TCL_OK;
}
@@ -1208,6 +1255,7 @@ TclLindexList(
int index; /* Index into the list. */
Tcl_Obj *indexListCopy;
+ List *listRepPtr;
/*
* Determine whether argPtr designates a list or a single index. We have
@@ -1215,7 +1263,8 @@ TclLindexList(
* shimmering; see TIP#22 and TIP#33 for the details.
*/
- if (argPtr->typePtr != &tclListType
+ ListGetIntRep(argPtr, listRepPtr);
+ if ((listRepPtr == NULL)
&& TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
/*
* argPtr designates a single index.
@@ -1246,13 +1295,12 @@ TclLindexList(
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
- {
- int indexCount = -1; /* Size of the array of list indices. */
- Tcl_Obj **indices = NULL; /* Array of list indices. */
+ ListGetIntRep(indexListCopy, listRepPtr);
- TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
- listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
- }
+ assert(listRepPtr != NULL);
+
+ listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
+ &listRepPtr->elements);
Tcl_DecrRefCount(indexListCopy);
return listPtr;
}
@@ -1387,6 +1435,7 @@ TclLsetList(
Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
int index; /* Current index in the list - discarded. */
Tcl_Obj *indexListCopy;
+ List *listRepPtr;
/*
* Determine whether the index arg designates a list or a single index.
@@ -1394,7 +1443,8 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
- if (indexArgPtr->typePtr != &tclListType
+ ListGetIntRep(indexArgPtr, listRepPtr);
+ if (listRepPtr == NULL
&& TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
/*
* indexArgPtr designates a single index.
@@ -1479,6 +1529,7 @@ TclLsetFlat(
{
int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
+ Tcl_ObjIntRep *irPtr;
/*
* If there are no indices, simply return the new value. (Without
@@ -1609,7 +1660,8 @@ TclLsetFlat(
* them at that time.
*/
- parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
+ irPtr = Tcl_FetchIntRep(parentList, &tclListType);
+ irPtr->twoPtrValue.ptr2 = chainPtr;
chainPtr = parentList;
}
} while (indexCount > 0);
@@ -1623,22 +1675,32 @@ TclLsetFlat(
while (chainPtr) {
Tcl_Obj *objPtr = chainPtr;
+ List *listRepPtr;
+
+ /*
+ * Clear away our intrep surgery mess.
+ */
+ irPtr = Tcl_FetchIntRep(objPtr, &tclListType);
+ listRepPtr = irPtr->twoPtrValue.ptr1;
+ chainPtr = irPtr->twoPtrValue.ptr2;
+
if (result == TCL_OK) {
+
/*
* We're going to store valuePtr, so spoil string reps of all
* containing lists.
*/
+ listRepPtr->refCount++;
+ TclFreeIntRep(objPtr);
+ ListSetIntRep(objPtr, listRepPtr);
+ listRepPtr->refCount--;
+
TclInvalidateStringRep(objPtr);
+ } else {
+ irPtr->twoPtrValue.ptr2 = NULL;
}
-
- /*
- * Clear away our intrep surgery mess.
- */
-
- chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
if (result != TCL_OK) {
@@ -1665,8 +1727,8 @@ TclLsetFlat(
Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
} else {
TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ TclInvalidateStringRep(subListPtr);
}
- TclInvalidateStringRep(subListPtr);
Tcl_IncrRefCount(retValuePtr);
return retValuePtr;
}
@@ -1722,10 +1784,13 @@ TclListObjSetElement(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
- if (listPtr->typePtr != &tclListType) {
- int result;
- if (listPtr->bytes == &tclEmptyString) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
@@ -1738,9 +1803,9 @@ TclListObjSetElement(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
/*
@@ -1783,7 +1848,8 @@ TclListObjSetElement(
listRepPtr->refCount--;
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
+ listRepPtr = newPtr;
+ ListResetIntRep(listPtr, listRepPtr);
}
elemPtrs = &listRepPtr->elements;
@@ -1805,6 +1871,18 @@ TclListObjSetElement(
elemPtrs[index] = valuePtr;
+ /*
+ * Invalidate outdated intreps.
+ */
+
+ ListGetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
+
+ TclInvalidateStringRep(listPtr);
+
return TCL_OK;
}
@@ -1820,9 +1898,8 @@ TclListObjSetElement(
* None.
*
* Side effects:
- * Frees listPtr's List* internal representation and sets listPtr's
- * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
- * element objects, which may free them.
+ * Frees listPtr's List* internal representation, if no longer shared.
+ * May decrement the ref counts of element objects, which may free them.
*
*----------------------------------------------------------------------
*/
@@ -1831,7 +1908,10 @@ static void
FreeListInternalRep(
Tcl_Obj *listPtr) /* List object with internal rep to free. */
{
- List *listRepPtr = ListRepPtr(listPtr);
+ List *listRepPtr;
+
+ ListGetIntRep(listPtr, listRepPtr);
+ assert(listRepPtr != NULL);
if (listRepPtr->refCount-- <= 1) {
Tcl_Obj **elemPtrs = &listRepPtr->elements;
@@ -1842,8 +1922,6 @@ FreeListInternalRep(
}
ckfree(listRepPtr);
}
-
- listPtr->typePtr = NULL;
}
/*
@@ -1868,8 +1946,10 @@ DupListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- List *listRepPtr = ListRepPtr(srcPtr);
+ List *listRepPtr;
+ ListGetIntRep(srcPtr, listRepPtr);
+ assert(listRepPtr != NULL);
ListSetIntRep(copyPtr, listRepPtr);
}
@@ -1908,7 +1988,7 @@ SetListFromAny(
* describe duplicate keys).
*/
- if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+ if (!TclHasStringRep(objPtr) && Tcl_FetchIntRep(objPtr, &tclDictType)) {
Tcl_Obj *keyPtr, *valuePtr;
Tcl_DictSearch search;
int done, size;
@@ -1966,10 +2046,12 @@ SetListFromAny(
while (nextElem < limit) {
const char *elemStart;
+ char *check;
int elemSize, literal;
if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
+ fail:
while (--elemPtrs >= &listRepPtr->elements) {
Tcl_DecrRefCount(*elemPtrs);
}
@@ -1980,14 +2062,21 @@ SetListFromAny(
break;
}
- /* TODO: replace panic with error on alloc failure? */
- if (literal) {
- TclNewStringObj(*elemPtrs, elemStart, elemSize);
- } else {
- TclNewObj(*elemPtrs);
- (*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
- (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
- (*elemPtrs)->bytes);
+ TclNewObj(*elemPtrs);
+ TclInvalidateStringRep(*elemPtrs);
+ check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
+ elemSize);
+ if (elemSize && check == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct list, out of memory", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ goto fail;
+ }
+ if (!literal) {
+ Tcl_InitStringRep(*elemPtrs, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, check));
}
Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
@@ -1997,12 +2086,11 @@ SetListFromAny(
}
/*
- * Free the old internalRep before setting the new one. We do this as late
+ * Store the new internalRep. We do this as late
* as possible to allow the conversion code, in particular
- * Tcl_GetStringFromObj, to use that old internalRep.
+ * Tcl_GetStringFromObj, to use the old internalRep.
*/
- TclFreeIntRep(objPtr);
ListSetIntRep(objPtr, listRepPtr);
return TCL_OK;
}
@@ -2034,12 +2122,17 @@ UpdateStringOfList(
{
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
- List *listRepPtr = ListRepPtr(listPtr);
- int numElems = listRepPtr->elemCount;
- int i, length, bytesNeeded = 0;
+ int numElems, i, length, bytesNeeded = 0;
const char *elem;
char *dst;
Tcl_Obj **elemPtrs;
+ List *listRepPtr;
+
+ ListGetIntRep(listPtr, listRepPtr);
+
+ assert(listRepPtr != NULL);
+
+ numElems = listRepPtr->elemCount;
/*
* Mark the list as being canonical; although it will now have a string
@@ -2054,8 +2147,7 @@ UpdateStringOfList(
*/
if (numElems == 0) {
- listPtr->bytes = &tclEmptyString;
- listPtr->length = 0;
+ Tcl_InitStringRep(listPtr, NULL, 0);
return;
}
@@ -2084,22 +2176,21 @@ UpdateStringOfList(
if (bytesNeeded > INT_MAX - numElems + 1) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- bytesNeeded += numElems;
+ bytesNeeded += numElems - 1;
/*
* Pass 2: copy into string rep buffer.
*/
- listPtr->length = bytesNeeded - 1;
- listPtr->bytes = ckalloc(bytesNeeded);
- dst = listPtr->bytes;
+ dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
+ TclOOM(dst, bytesNeeded);
for (i = 0; i < numElems; i++) {
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
*dst++ = ' ';
}
- listPtr->bytes[listPtr->length] = '\0';
+ (void) Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
if (flagPtr != localFlags) {
ckfree(flagPtr);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 2b8dd51..27aafc3 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -25,6 +25,7 @@
#include "tclInt.h"
#include "tclCompile.h" /* for TclLogCommandInfo visibility */
+#include <assert.h>
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -152,6 +153,22 @@ static const Tcl_ObjType nsNameType = {
SetNsNameFromAny /* setFromAnyProc */
};
+#define NsNameSetIntRep(objPtr, nnPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (nnPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (nnPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \
+ } while (0)
+
+#define NsNameGetIntRep(objPtr, nnPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &nsNameType); \
+ (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* Array of values describing how to implement each standard subcommand of the
* "namespace" command.
@@ -2898,15 +2915,16 @@ GetNamespaceFromObj(
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
ResolvedNsName *resNamePtr;
- Namespace *nsPtr, *refNsPtr;
- if (objPtr->typePtr == &nsNameType) {
+ NsNameGetIntRep(objPtr, resNamePtr);
+ if (resNamePtr) {
+ Namespace *nsPtr, *refNsPtr;
+
/*
* Check that the ResolvedNsName is still valid; avoid letting the ref
* cross interps.
*/
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
@@ -2915,9 +2933,11 @@ GetNamespaceFromObj(
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
return TCL_OK;
}
+ Tcl_StoreIntRep(objPtr, &nsNameType, NULL);
}
if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
return TCL_OK;
}
@@ -4687,8 +4707,11 @@ FreeNsNameInternalRep(
register Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
- ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
+
/*
* Decrement the reference count of the namespace. If there are no more
* references, free it up.
@@ -4704,7 +4727,6 @@ FreeNsNameInternalRep(
TclNsDecrRefCount(resNamePtr->nsPtr);
ckfree(resNamePtr);
}
- objPtr->typePtr = NULL;
}
/*
@@ -4731,11 +4753,11 @@ DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
- copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- resNamePtr->refCount++;
- copyPtr->typePtr = &nsNameType;
+ NsNameGetIntRep(srcPtr, resNamePtr);
+ assert(resNamePtr != NULL);
+ NsNameSetIntRep(copyPtr, resNamePtr);
}
/*
@@ -4780,24 +4802,15 @@ SetNsNameFromAny(
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+ return TCL_ERROR;
+ }
+
/*
* If we found a namespace, then create a new ResolvedNsName structure
* that holds a reference to it.
*/
- if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
- /*
- * Our failed lookup proves any previously cached nsName intrep is no
- * longer valid. Get rid of it so we no longer waste memory storing
- * it, nor time determining its invalidity again and again.
- */
-
- if (objPtr->typePtr == &nsNameType) {
- TclFreeIntRep(objPtr);
- }
- return TCL_ERROR;
- }
-
nsPtr->refCount++;
resNamePtr = ckalloc(sizeof(ResolvedNsName));
resNamePtr->nsPtr = nsPtr;
@@ -4806,10 +4819,8 @@ SetNsNameFromAny(
} else {
resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
- resNamePtr->refCount = 1;
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- objPtr->typePtr = &nsNameType;
+ resNamePtr->refCount = 0;
+ NsNameSetIntRep(objPtr, resNamePtr);
return TCL_OK;
}
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 9d5312c..50a9c80 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -15,6 +15,7 @@
#endif
#include "tclInt.h"
#include "tclOOInt.h"
+#include <assert.h>
/*
* Structure containing a CallContext and any other values needed only during
@@ -128,6 +129,7 @@ static const Tcl_ObjType methodNameType = {
NULL,
NULL
};
+
/*
* ----------------------------------------------------------------------
@@ -222,11 +224,12 @@ StashCallChain(
Tcl_Obj *objPtr,
CallChain *callPtr)
{
+ Tcl_ObjIntRep ir;
+
callPtr->refCount++;
TclGetString(objPtr);
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &methodNameType;
- objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+ ir.twoPtrValue.ptr1 = callPtr;
+ Tcl_StoreIntRep(objPtr, &methodNameType, &ir);
}
void
@@ -253,21 +256,16 @@ DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
- register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-
- dstPtr->typePtr = &methodNameType;
- dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
- callPtr->refCount++;
+ StashCallChain(dstPtr,
+ Tcl_FetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}
static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
- register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
- TclOODeleteChain(callPtr);
- objPtr->typePtr = NULL;
+ TclOODeleteChain(
+ Tcl_FetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}
/*
@@ -1165,15 +1163,16 @@ TclOOGetCallContext(
* the object, and in the class).
*/
+ const Tcl_ObjIntRep *irPtr;
const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
- if (cacheInThisObj->typePtr == &methodNameType) {
- callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = Tcl_FetchIntRep(cacheInThisObj, &methodNameType))) {
+ callPtr = irPtr->twoPtrValue.ptr1;
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
}
- FreeMethodNameRep(cacheInThisObj);
+ Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
}
if (oPtr->flags & USE_CLASS_CACHE) {
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index ad14a1a..545cb47 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -799,6 +799,7 @@ PushMethodCallFrame(
register int result;
const char *namePtr;
CallFrame **framePtrPtr = &fdPtr->framePtr;
+ ByteCode *codePtr;
/*
* Compute basic information on the basis of the type of method it is.
@@ -864,10 +865,8 @@ PushMethodCallFrame(
* alternative is *so* slow...
*/
- if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
- ByteCode *codePtr =
- pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
-
+ ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr) {
codePtr->nsPtr = nsPtr;
}
result = TclProcCompileProc(interp, pmPtr->procPtr,
@@ -1341,7 +1340,7 @@ CloneProcedureMethod(
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
Tcl_GetString(bodyObj);
- TclFreeIntRep(bodyObj);
+ Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);
/*
* Create the actual copy of the method record, manufacturing a new proc
@@ -1570,9 +1569,7 @@ TclOOGetMethodBody(
if (mPtr->typePtr == &procMethodType) {
ProcedureMethod *pmPtr = mPtr->clientData;
- if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
- (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
- }
+ (void) TclGetString(pmPtr->procPtr->bodyPtr);
return pmPtr->procPtr->bodyPtr;
}
return NULL;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5a8ce3b..6a4d161 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tommath.h"
#include <math.h>
+#include <assert.h>
/*
* Table of all object types.
@@ -1065,9 +1066,8 @@ TclDbInitNewObj(
* debugging. */
{
objPtr->refCount = 0;
- objPtr->bytes = &tclEmptyString;
- objPtr->length = 0;
objPtr->typePtr = NULL;
+ TclInitStringRep(objPtr, NULL, 0);
#if TCL_THREADS
/*
@@ -1725,6 +1725,91 @@ Tcl_GetStringFromObj(
/*
*----------------------------------------------------------------------
*
+ * Tcl_InitStringRep --
+ *
+ * This function is called in several configurations to provide all
+ * the tools needed to set an object's string representation. The
+ * function is determined by the arguments.
+ *
+ * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0)
+ * Invalid call -- panic!
+ *
+ * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
+ * Allocation only - allocate space for (numBytes+1) chars.
+ * store in objPtr->bytes and return. Also sets
+ * objPtr->length to 0 and objPtr->bytes[0] to NUL.
+ *
+ * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0
+ * Allocate and copy. bytes is assumed to point to chars to
+ * copy into the string rep. objPtr->length = numBytes. Allocate
+ * array of (numBytes + 1) chars. store in objPtr->bytes. Copy
+ * numBytes chars from bytes to objPtr->bytes; Set
+ * objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
+ * Caller must guarantee there are numBytes chars at bytes to
+ * be copied.
+ *
+ * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0
+ * Truncate. Set objPtr->length to numBytes and
+ * objPr->bytes[numBytes] to NUL. Caller has to guarantee
+ * that a prior allocating call allocated enough bytes for
+ * this to be valid. Return objPtr->bytes.
+ *
+ * Caller is expected to ascertain that the bytes copied into
+ * the string rep make up complete valid UTF-8 characters.
+ *
+ * Results:
+ * A pointer to the string rep of objPtr.
+ *
+ * Side effects:
+ * As described above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_InitStringRep(
+ Tcl_Obj *objPtr, /* Object whose string rep is to be set */
+ const char *bytes,
+ unsigned int numBytes)
+{
+ assert(objPtr->bytes == NULL || bytes == NULL);
+
+ if (numBytes > INT_MAX) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ /* Allocate */
+ if (objPtr->bytes == NULL) {
+ /* Allocate only as empty - extend later if bytes copied */
+ objPtr->length = 0;
+ if (numBytes) {
+ objPtr->bytes = attemptckalloc(numBytes + 1);
+ if (objPtr->bytes == NULL) {
+ return NULL;
+ }
+ if (bytes) {
+ /* Copy */
+ memcpy(objPtr->bytes, bytes, numBytes);
+ objPtr->length = (int) numBytes;
+ }
+ } else {
+ TclInitStringRep(objPtr, NULL, 0);
+ }
+ } else {
+ /* objPtr->bytes != NULL bytes == NULL - Truncate */
+ objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1);
+ objPtr->length = (int)numBytes;
+ }
+
+ /* Terminate */
+ objPtr->bytes[objPtr->length] = '\0';
+
+ return objPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_InvalidateStringRep --
*
* This function is called to invalidate an object's string
@@ -1751,6 +1836,123 @@ Tcl_InvalidateStringRep(
/*
*----------------------------------------------------------------------
*
+ * Tcl_HasStringRep --
+ *
+ * This function reports whether object has a string representation.
+ *
+ * Results:
+ * Boolean.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HasStringRep(
+ Tcl_Obj *objPtr) /* Object to test */
+{
+ return TclHasStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StoreIntRep --
+ *
+ * This function is called to set the object's internal
+ * representation to match a particular type.
+ *
+ * It is the caller's responsibility to guarantee that
+ * the value of the submitted IntRep is in agreement with
+ * the value of any existing string rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_StoreIntRep(
+ Tcl_Obj *objPtr, /* Object whose internal rep should be set. */
+ const Tcl_ObjType *typePtr, /* New type for the object */
+ const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */
+{
+ /* Clear out any existing IntRep ( "shimmer" ) */
+ TclFreeIntRep(objPtr);
+
+ /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
+ if (irPtr) {
+ /* Copy the new IntRep into place */
+ objPtr->internalRep = *irPtr;
+
+ /* Set the type to match */
+ objPtr->typePtr = typePtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FetchIntRep --
+ *
+ * This function is called to retrieve the object's internal
+ * representation matching a requested type, if any.
+ *
+ * Results:
+ * A read-only pointer to the associated Tcl_ObjIntRep, or
+ * NULL if no such internal representation exists.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ObjIntRep *
+Tcl_FetchIntRep(
+ Tcl_Obj *objPtr, /* Object to fetch from. */
+ const Tcl_ObjType *typePtr) /* Requested type */
+{
+ /* If objPtr type doesn't match request, nothing can be fetched */
+ if (objPtr->typePtr != typePtr) {
+ return NULL;
+ }
+
+ /* Type match! objPtr IntRep is the one sought. */
+ return &(objPtr->internalRep);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeIntRep --
+ *
+ * This function is called to free an object's internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets typePtr field to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeIntRep(
+ Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */
+{
+ TclFreeIntRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_NewBooleanObj --
*
* This function is normally called when not debugging: i.e., when
@@ -1835,6 +2037,7 @@ Tcl_DbNewBooleanObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = (boolValue != 0);
@@ -2221,6 +2424,7 @@ Tcl_DbNewDoubleObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
@@ -2381,15 +2585,12 @@ static void
UpdateStringOfDouble(
register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
{
- char buffer[TCL_DOUBLE_SPACE];
- register int len;
+ char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);
- Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
- len = strlen(buffer);
+ TclOOM(dst, TCL_DOUBLE_SPACE + 1);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
+ Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
+ (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
}
/*
@@ -2578,14 +2779,11 @@ static void
UpdateStringOfInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
- char buffer[TCL_INTEGER_SPACE];
- register int len;
-
- len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
+ char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
+ TclOOM(dst, TCL_INTEGER_SPACE + 1);
+ (void) Tcl_InitStringRep(objPtr, NULL,
+ TclFormatInt(dst, objPtr->internalRep.wideValue));
}
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
@@ -2593,14 +2791,11 @@ static void
UpdateStringOfOldInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
- char buffer[TCL_INTEGER_SPACE];
- register int len;
+ char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
- len = TclFormatInt(buffer, objPtr->internalRep.longValue);
-
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
+ TclOOM(dst, TCL_INTEGER_SPACE + 1);
+ (void) Tcl_InitStringRep(objPtr, NULL,
+ TclFormatInt(dst, objPtr->internalRep.longValue));
}
#endif
@@ -2706,6 +2901,7 @@ Tcl_DbNewLongObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep */
objPtr->bytes = NULL;
objPtr->internalRep.wideValue = longValue;
@@ -3262,12 +3458,10 @@ UpdateStringOfBignum(
{
mp_int bignumVal;
int size;
- int status;
char *stringVal;
UNPACK_BIGNUM(objPtr, bignumVal);
- status = mp_radix_size(&bignumVal, 10, &size);
- if (status != MP_OKAY) {
+ if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
if (size < 2) {
@@ -3282,13 +3476,14 @@ UpdateStringOfBignum(
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
- stringVal = ckalloc(size);
- status = mp_toradix_n(&bignumVal, stringVal, 10, size);
- if (status != MP_OKAY) {
+
+ stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);
+
+ TclOOM(stringVal, size);
+ if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
- objPtr->bytes = stringVal;
- objPtr->length = size - 1; /* size includes a trailing NUL byte. */
+ (void) Tcl_InitStringRep(objPtr, NULL, size - 1);
}
/*
@@ -3408,11 +3603,17 @@ GetBignumFromObj(
mp_init_copy(bignumValue, &temp);
} else {
UNPACK_BIGNUM(objPtr, *bignumValue);
+ /* Optimized TclFreeIntRep */
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
+ /*
+ * TODO: If objPtr has a string rep, this leaves
+ * it undisturbed. Not clear that's proper. Pure
+ * bignum values are converted to empty string.
+ */
if (objPtr->bytes == NULL) {
- TclInitStringRep(objPtr, &tclEmptyString, 0);
+ TclInitStringRep(objPtr, NULL, 0);
}
}
return TCL_OK;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 2453c46..c072fe0 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -36,7 +36,7 @@ static int MakePathFromNormalized(Tcl_Interp *interp,
* internally.
*/
-static const Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType fsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
@@ -51,19 +51,14 @@ static const Tcl_ObjType tclFsPathType = {
* represent relative or absolute paths, and has certain optimisations when
* used to represent paths which are already normalized and absolute.
*
- * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
- * reference to the container Tcl_Obj of this FsPath.
- *
* There are two cases, with the first being the most common:
*
* (i) flags == 0, => Ordinary path.
*
- * translatedPathPtr contains the translated path (which may be a circular
- * reference to the object itself). If it is NULL then the path is pure
- * normalized (and the normPathPtr will be a circular reference). cwdPtr is
- * null for an absolute path, and non-null for a relative path (unless the cwd
- * has never been set, in which case the cwdPtr may also be null for a
- * relative path).
+ * translatedPathPtr contains the translated path. If it is NULL then the path
+ * is pure normalized. cwdPtr is null for an absolute path, and non-null for a
+ * relative path (unless the cwd has never been set, in which case the cwdPtr
+ * may also be null for a relative path).
*
* (ii) flags != 0, => Special path, see TclNewFSPathObj
*
@@ -79,11 +74,7 @@ typedef struct FsPath {
* Tcl_Obj's string rep is already both
* translated and normalized. */
Tcl_Obj *normPathPtr; /* Normalized absolute path, without ., .. or
- * ~user sequences. If the Tcl_Obj containing
- * this FsPath is already normalized, this may
- * be a circular reference back to the
- * container. If that is NOT the case, we have
- * a refCount on the object. */
+ * ~user sequences. */
Tcl_Obj *cwdPtr; /* If null, path is absolute, else this points
* to the cwd object used for this path. We
* have a refCount on the object. */
@@ -110,9 +101,14 @@ typedef struct FsPath {
* fields.
*/
-#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
+#define PATHOBJ(pathPtr) ((FsPath *) (Tcl_FetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define SETPATHOBJ(pathPtr,fsPathPtr) \
- ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \
+ } while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
@@ -564,7 +560,9 @@ TclPathPart(
Tcl_Obj *pathPtr, /* Path to take dirname of */
Tcl_PathPart portion) /* Requested portion of name */
{
- if (pathPtr->typePtr == &tclFsPathType) {
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
+ if (irPtr) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0) {
@@ -864,6 +862,7 @@ TclJoinPath(
if (elements == 2) {
Tcl_Obj *elt = objv[0];
+ Tcl_ObjIntRep *eltIr = Tcl_FetchIntRep(elt, &fsPathType);
/*
* This is a special case where we can be much more efficient, where
@@ -877,7 +876,7 @@ TclJoinPath(
* to be an absolute path. Added a check for that elt is absolute.
*/
- if ((elt->typePtr == &tclFsPathType)
+ if ((eltIr)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[1];
@@ -1154,6 +1153,8 @@ Tcl_FSConvertToPathType(
Tcl_Obj *pathPtr) /* Object to convert to a valid, current path
* type. */
{
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
/*
* While it is bad practice to examine an object's type directly, this is
* actually the best thing to do here. The reason is that if we are
@@ -1164,39 +1165,16 @@ Tcl_FSConvertToPathType(
* path.
*/
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
return TCL_OK;
}
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
}
return SetFsPathFromAny(interp, pathPtr);
-
- /*
- * We used to have more complex code here:
- *
- * FsPath *fsPathPtr = PATHOBJ(pathPtr);
- * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
- * return TCL_OK;
- * } else {
- * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
- * return TCL_OK;
- * } else {
- * if (pathPtr->bytes == NULL) {
- * UpdateStringOfFsPath(pathPtr);
- * }
- * FreeFsPathInternalRep(pathPtr);
- * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
- * }
- * }
- *
- * But we no longer believe this is necessary.
- */
}
/*
@@ -1328,9 +1306,7 @@ TclNewFSPathObj(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
- pathPtr->typePtr = &tclFsPathType;
- pathPtr->bytes = NULL;
- pathPtr->length = 0;
+ TclInvalidateStringRep(pathPtr);
/*
* Look for path components made up of only "."
@@ -1430,8 +1406,9 @@ TclFSMakePathRelative(
{
int cwdLen, len;
const char *tempStr;
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
@@ -1498,31 +1475,12 @@ MakePathFromNormalized(
Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
return TCL_OK;
}
- /*
- * Free old representation
- */
-
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't find object string representation", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
- NULL);
- }
- return TCL_ERROR;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
fsPathPtr = ckalloc(sizeof(FsPath));
/*
@@ -1531,11 +1489,7 @@ MakePathFromNormalized(
fsPathPtr->translatedPathPtr = NULL;
- /*
- * Circular reference by design.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
@@ -1544,7 +1498,6 @@ MakePathFromNormalized(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return TCL_OK;
}
@@ -1595,25 +1548,12 @@ Tcl_FSNewNativePath(
* safe.
*/
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- return NULL;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
- /*
- * Circular reference, by design.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsPtr = fromFilesystem;
@@ -1621,7 +1561,6 @@ Tcl_FSNewNativePath(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return pathPtr;
}
@@ -1668,20 +1607,22 @@ Tcl_FSGetTranslatedPath(
Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
srcFsPathPtr->cwdPtr);
+ Tcl_ObjIntRep *translatedCwdIrPtr;
+
if (translatedCwdPtr == NULL) {
return NULL;
}
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
- srcFsPathPtr->translatedPathPtr = retObj;
- if (translatedCwdPtr->typePtr == &tclFsPathType) {
+ Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj);
+ translatedCwdIrPtr = Tcl_FetchIntRep(translatedCwdPtr, &fsPathType);
+ if (translatedCwdIrPtr) {
srcFsPathPtr->filesystemEpoch
= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
} else {
srcFsPathPtr->filesystemEpoch = 0;
}
- Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
} else {
/*
@@ -1791,9 +1732,7 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
/* TODO: Figure out why this is needed. */
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
+ TclGetString(pathPtr);
TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
if (tailLen) {
@@ -1845,7 +1784,7 @@ Tcl_FSGetNormalizedPath(
/*
* NOTE: here we are (dangerously?) assuming that origDir points
- * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The
+ * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The
* pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
* above that set the pathType value should have established that,
* but it's far less clear on what basis we know there's been no
@@ -1863,6 +1802,7 @@ Tcl_FSGetNormalizedPath(
/*
* That's our reference to copy used.
*/
+ copy = NULL;
TclDecrRefCount(dir);
TclDecrRefCount(origDir);
@@ -1875,7 +1815,7 @@ Tcl_FSGetNormalizedPath(
/*
* That's our reference to copy used.
*/
-
+ copy = NULL;
TclDecrRefCount(dir);
}
PATHFLAGS(pathPtr) = 0;
@@ -1887,10 +1827,8 @@ Tcl_FSGetNormalizedPath(
if (fsPathPtr->cwdPtr != NULL) {
if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
return NULL;
}
@@ -1916,7 +1854,6 @@ Tcl_FSGetNormalizedPath(
}
if (fsPathPtr->normPathPtr == NULL) {
Tcl_Obj *useThisCwd = NULL;
- int pureNormalized = 1;
/*
* Since normPathPtr is NULL, but this is a valid path object, we know
@@ -1966,7 +1903,6 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
- pureNormalized = 0;
Tcl_DecrRefCount(absolutePath);
absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
Tcl_IncrRefCount(absolutePath);
@@ -1986,7 +1922,6 @@ Tcl_FSGetNormalizedPath(
if (absolutePath == NULL) {
return NULL;
}
- pureNormalized = 0;
#endif /* _WIN32 */
}
}
@@ -1995,35 +1930,12 @@ Tcl_FSGetNormalizedPath(
* Already has refCount incremented.
*/
+ if (fsPathPtr->normPathPtr) {
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+ }
fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
absolutePath);
- /*
- * Check if path is pure normalized (this can only be the case if it
- * is an absolute path).
- */
-
- if (pureNormalized) {
- int normPathLen, pathLen;
- const char *normPath;
-
- path = TclGetStringFromObj(pathPtr, &pathLen);
- normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
- if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
- /*
- * The path was already normalized. Get rid of the duplicate.
- */
-
- TclDecrRefCount(fsPathPtr->normPathPtr);
-
- /*
- * We do *not* increment the refCount for this circular
- * reference.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
- }
- }
if (useThisCwd != NULL) {
/*
* We just need to free an object we allocated above for relative
@@ -2169,8 +2081,9 @@ TclFSEnsureEpochOk(
const Tcl_Filesystem **fsPtrPtr)
{
FsPath *srcFsPathPtr;
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr != &tclFsPathType) {
+ if (irPtr == NULL) {
return TCL_OK;
}
@@ -2186,10 +2099,8 @@ TclFSEnsureEpochOk(
* We have to discard the stale representation and recalculate it.
*/
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -2229,12 +2140,13 @@ TclFSSetPathDetails(
ClientData clientData)
{
FsPath *srcFsPathPtr;
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);;
/*
* Make sure pathPtr is of the correct type.
*/
- if (pathPtr->typePtr != &tclFsPathType) {
+ if (irPtr == NULL) {
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return;
}
@@ -2332,8 +2244,9 @@ SetFsPathFromAny(
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
return TCL_OK;
}
@@ -2475,27 +2388,21 @@ SetFsPathFromAny(
fsPathPtr = ckalloc(sizeof(FsPath));
- fsPathPtr->translatedPathPtr = transPtr;
- if (transPtr != pathPtr) {
- Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
- /* Redo translation when $env(HOME) changes */
- fsPathPtr->filesystemEpoch = TclFSEpoch();
+ if (transPtr == pathPtr) {
+ transPtr = Tcl_DuplicateObj(pathPtr);
+ fsPathPtr->filesystemEpoch = 0;
} else {
- fsPathPtr->filesystemEpoch = 0;
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
}
+ Tcl_IncrRefCount(transPtr);
+ fsPathPtr->translatedPathPtr = transPtr;
fsPathPtr->normPathPtr = NULL;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
- /*
- * Free old representation before installing our new one.
- */
-
- TclFreeIntRep(pathPtr);
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return TCL_OK;
}
@@ -2518,6 +2425,7 @@ FreeFsPathInternalRep(
}
if (fsPathPtr->cwdPtr != NULL) {
TclDecrRefCount(fsPathPtr->cwdPtr);
+ fsPathPtr->cwdPtr = NULL;
}
if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
Tcl_FSFreeInternalRepProc *freeProc =
@@ -2530,7 +2438,6 @@ FreeFsPathInternalRep(
}
ckfree(fsPathPtr);
- pathPtr->typePtr = NULL;
}
static void
@@ -2543,24 +2450,14 @@ DupFsPathInternalRep(
SETPATHOBJ(copyPtr, copyFsPathPtr);
- if (srcFsPathPtr->translatedPathPtr == srcPtr) {
- /* Cycle in src -> make cycle in copy. */
- copyFsPathPtr->translatedPathPtr = copyPtr;
- } else {
- copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
- if (copyFsPathPtr->translatedPathPtr != NULL) {
- Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
- }
+ copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
+ if (copyFsPathPtr->translatedPathPtr != NULL) {
+ Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
}
- if (srcFsPathPtr->normPathPtr == srcPtr) {
- /* Cycle in src -> make cycle in copy. */
- copyFsPathPtr->normPathPtr = copyPtr;
- } else {
- copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
- if (copyFsPathPtr->normPathPtr != NULL) {
- Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
- }
+ copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
+ if (copyFsPathPtr->normPathPtr != NULL) {
+ Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
}
copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
@@ -2586,8 +2483,6 @@ DupFsPathInternalRep(
}
copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
-
- copyPtr->typePtr = &tclFsPathType;
}
/*
@@ -2619,11 +2514,15 @@ UpdateStringOfFsPath(
}
copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
+ if (Tcl_IsShared(copy)) {
+ copy = Tcl_DuplicateObj(copy);
+ }
+ Tcl_IncrRefCount(copy);
+ /* Steal copy's string rep */
pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
pathPtr->length = cwdLen;
- copy->bytes = &tclEmptyString;
- copy->length = 0;
+ TclInitStringRep(copy, NULL, 0);
TclDecrRefCount(copy);
}
@@ -2653,6 +2552,8 @@ TclNativePathInFilesystem(
Tcl_Obj *pathPtr,
ClientData *clientDataPtr)
{
+ Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
/*
* A special case is required to handle the empty path "". This is a valid
* path (i.e. the user should be able to do 'file exists ""' without
@@ -2660,7 +2561,7 @@ TclNativePathInFilesystem(
* semantics of Tcl (at present anyway), so we have to abide by them here.
*/
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
/*
* We reject the empty path "".
@@ -2675,7 +2576,7 @@ TclNativePathInFilesystem(
} else {
/*
* It is somewhat unusual to reach this code path without the object
- * being of tclFsPathType. However, we do our best to deal with the
+ * being of fsPathType. However, we do our best to deal with the
* situation.
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 32c3b2e..f1822a2 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -15,6 +15,7 @@
#include "tclInt.h"
#include "tclCompile.h"
+#include <assert.h>
/*
* Variables that are part of the [apply] command implementation and which
@@ -67,6 +68,22 @@ const Tcl_ObjType tclProcBodyType = {
* should panic instead. */
};
+#define ProcSetIntRep(objPtr, procPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (procPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (procPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir); \
+ } while (0)
+
+#define ProcGetIntRep(objPtr, procPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &tclProcBodyType); \
+ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* The [upvar]/[uplevel] level reference type. Uses the longValue field
* to remember the integer value of a parsed #<integer> format.
@@ -89,13 +106,31 @@ static const Tcl_ObjType levelReferenceType = {
* will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
*/
-const Tcl_ObjType tclLambdaType = {
+static const Tcl_ObjType lambdaType = {
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetLambdaFromAny /* setFromAnyProc */
};
+
+#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (procPtr); \
+ ir.twoPtrValue.ptr2 = (nsObjPtr); \
+ Tcl_IncrRefCount((nsObjPtr)); \
+ Tcl_StoreIntRep((objPtr), &lambdaType, &ir); \
+ } while (0)
+
+#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &lambdaType); \
+ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -294,7 +329,7 @@ Tcl_ProcObjCmd(
* of all procs whose argument list is just _args_
*/
- if (objv[3]->typePtr == &tclProcBodyType) {
+ if (Tcl_FetchIntRep(objv[3], &tclProcBodyType)) {
goto done;
}
@@ -370,7 +405,7 @@ TclCreateProc(
{
Interp *iPtr = (Interp *) interp;
- register Proc *procPtr;
+ register Proc *procPtr = NULL;
int i, result, numArgs, plen;
const char *bytes, *argname, *argnamei;
char argnamelast;
@@ -378,7 +413,8 @@ TclCreateProc(
Tcl_Obj *defPtr, *errorObj, **argArray;
int precompiled = 0;
- if (bodyPtr->typePtr == &tclProcBodyType) {
+ ProcGetIntRep(bodyPtr, procPtr);
+ if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
@@ -391,7 +427,6 @@ TclCreateProc(
* will be holding a reference to it.
*/
- procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
@@ -733,6 +768,7 @@ TclObjGetFrame(
{
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
+ const Tcl_ObjIntRep *irPtr;
const char *name = NULL;
Tcl_WideInt w;
@@ -758,8 +794,8 @@ TclObjGetFrame(
level = curLevel - level;
result = 1;
}
- } else if (objPtr->typePtr == &levelReferenceType) {
- level = (int) objPtr->internalRep.wideValue;
+ } else if ((irPtr = Tcl_FetchIntRep(objPtr, &levelReferenceType))) {
+ level = irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
@@ -768,9 +804,10 @@ TclObjGetFrame(
if (level < 0 || (level > 0 && name[1] == '-')) {
result = -1;
} else {
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.wideValue = level;
+ Tcl_ObjIntRep ir;
+
+ ir.wideValue = level;
+ Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir);
result = 1;
}
} else {
@@ -1094,10 +1131,10 @@ TclInitCompiledLocals(
ByteCode *codePtr;
bodyPtr = framePtr->procPtr->bodyPtr;
- if (bodyPtr->typePtr != &tclByteCodeType) {
+ ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr == NULL) {
Tcl_Panic("body object for proc attached to frame is not a byte code type");
}
- codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
if (framePtr->numCompiledLocals) {
if (!codePtr->localCachePtr) {
@@ -1260,7 +1297,7 @@ InitLocalCache(
Proc *procPtr)
{
Interp *iPtr = procPtr->iPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
int localCt = procPtr->numCompiledLocals;
int numArgs = procPtr->numArgs, i = 0;
@@ -1270,6 +1307,8 @@ InitLocalCache(
CompiledLocal *localPtr;
int new;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
/*
* Cache the names and initial values of local variables; store the
* cache in both the framePtr for this execution and in the codePtr
@@ -1337,11 +1376,13 @@ InitArgsAndLocals(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
register Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
/*
* Make sure that the local cache of variable names and initial values has
* been initialised properly .
@@ -1516,7 +1557,8 @@ TclPushProcCallFrame(
* local variables are found while compiling.
*/
- if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr != NULL) {
Interp *iPtr = (Interp *) interp;
/*
@@ -1528,7 +1570,6 @@ TclPushProcCallFrame(
* commands and/or resolver changes are considered).
*/
- codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
@@ -1726,7 +1767,7 @@ TclNRInterpProcCore(
*/
procPtr->refCount++;
- codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
@@ -1860,7 +1901,9 @@ TclProcCompileProc(
{
Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
- ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+
+ ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
/*
* If necessary, compile the procedure's body. The compiler will allocate
@@ -1876,7 +1919,7 @@ TclProcCompileProc(
* are not recompiled, even if things have changed.
*/
- if (bodyPtr->typePtr == &tclByteCodeType) {
+ if (codePtr != NULL) {
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == nsPtr)
@@ -1895,11 +1938,12 @@ TclProcCompileProc(
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
- TclFreeIntRep(bodyPtr);
+ Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL);
+ codePtr = NULL;
}
}
- if (bodyPtr->typePtr != &tclByteCodeType) {
+ if (codePtr == NULL) {
Tcl_HashEntry *hePtr;
#ifdef TCL_COMPILE_DEBUG
@@ -2248,10 +2292,7 @@ TclNewProcBodyObj(
TclNewObj(objPtr);
if (objPtr) {
- objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-
- procPtr->refCount++;
+ ProcSetIntRep(objPtr, procPtr);
}
return objPtr;
@@ -2279,11 +2320,10 @@ ProcBodyDup(
Tcl_Obj *srcPtr, /* Object to copy. */
Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
- Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ Proc *procPtr;
+ ProcGetIntRep(srcPtr, procPtr);
- dupPtr->typePtr = &tclProcBodyType;
- dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- procPtr->refCount++;
+ ProcSetIntRep(dupPtr, procPtr);
}
/*
@@ -2309,7 +2349,9 @@ static void
ProcBodyFree(
Tcl_Obj *objPtr) /* The object to clean up. */
{
- Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ Proc *procPtr;
+
+ ProcGetIntRep(objPtr, procPtr);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
@@ -2335,15 +2377,15 @@ DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
- copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+ LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
+ assert(procPtr != NULL);
procPtr->refCount++;
- Tcl_IncrRefCount(nsObjPtr);
- copyPtr->typePtr = &tclLambdaType;
+
+ LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
}
static void
@@ -2351,14 +2393,16 @@ FreeLambdaInternalRep(
register Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
- Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
+
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+ assert(procPtr != NULL);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
- objPtr->typePtr = NULL;
}
static int
@@ -2379,7 +2423,7 @@ SetLambdaFromAny(
/*
* Convert objPtr to list type first; if it cannot be converted, or if its
- * length is not 2, then it cannot be converted to tclLambdaType.
+ * length is not 2, then it cannot be converted to lambdaType.
*/
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2520,21 +2564,42 @@ SetLambdaFromAny(
}
}
- Tcl_IncrRefCount(nsObjPtr);
-
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
- * conversion to tclLambdaType.
+ * conversion to lambdaType.
*/
- TclFreeIntRep(objPtr);
-
- objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
- objPtr->typePtr = &tclLambdaType;
+ LambdaSetIntRep(objPtr, procPtr, nsObjPtr);
return TCL_OK;
}
+
+Proc *
+TclGetLambdaFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Obj **nsObjPtrPtr)
+{
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
+
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+
+ if (procPtr == NULL) {
+ if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
+ return NULL;
+ }
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+ }
+
+ assert(procPtr != NULL);
+ if (procPtr->iPtr != (Interp *)interp) {
+ return NULL;
+ }
+
+ *nsObjPtrPtr = nsObjPtr;
+ return procPtr;
+}
/*
*----------------------------------------------------------------------
@@ -2570,7 +2635,6 @@ TclNRApplyObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
int result;
@@ -2588,24 +2652,17 @@ TclNRApplyObjCmd(
*/
lambdaPtr = objv[1];
- if (lambdaPtr->typePtr == &tclLambdaType) {
- procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
- }
+ procPtr = TclGetLambdaFromObj(interp, lambdaPtr, &nsObjPtr);
- if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
- result = SetLambdaFromAny(interp, lambdaPtr);
- if (result != TCL_OK) {
- return result;
- }
- procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+ if (procPtr == NULL) {
+ return TCL_ERROR;
}
/*
- * Find the namespace where this lambda should run, and push a call frame
- * for that namespace. Note that TclObjInterpProc() will pop it.
+ * Push a call frame for the lambda namespace.
+ * Note that TclObjInterpProc() will pop it.
*/
- nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return TCL_ERROR;
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index 5f8dc20..a01ace3 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -13,6 +13,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include <assert.h>
/*
*----------------------------------------------------------------------
@@ -107,6 +108,23 @@ const Tcl_ObjType tclRegexpType = {
NULL, /* updateStringProc */
SetRegexpFromAny /* setFromAnyProc */
};
+
+#define RegexpSetIntRep(objPtr, rePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (rePtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (rePtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir); \
+ } while (0)
+
+#define RegexpGetIntRep(objPtr, rePtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &tclRegexpType); \
+ (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -580,14 +598,9 @@ Tcl_GetRegExpFromObj(
TclRegexp *regexpPtr;
const char *pattern;
- /*
- * This is OK because we only actually interpret this value properly as a
- * TclRegexp* when the type is tclRegexpType.
- */
-
- regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ RegexpGetIntRep(objPtr, regexpPtr);
- if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+ if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
pattern = TclGetStringFromObj(objPtr, &length);
regexpPtr = CompileRegexp(interp, pattern, length, flags);
@@ -595,21 +608,7 @@ Tcl_GetRegExpFromObj(
return NULL;
}
- /*
- * Add a reference to the regexp so it will persist even if it is
- * pushed out of the current thread's regexp cache. This reference
- * will be removed when the object's internal rep is freed.
- */
-
- regexpPtr->refCount++;
-
- /*
- * Free the old representation and set our type.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
- objPtr->typePtr = &tclRegexpType;
+ RegexpSetIntRep(objPtr, regexpPtr);
}
return (Tcl_RegExp) regexpPtr;
}
@@ -756,7 +755,11 @@ static void
FreeRegexpInternalRep(
Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
- TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ TclRegexp *regexpRepPtr;
+
+ RegexpGetIntRep(objPtr, regexpRepPtr);
+
+ assert(regexpRepPtr != NULL);
/*
* If this is the last reference to the regexp, free it.
@@ -765,7 +768,6 @@ FreeRegexpInternalRep(
if (regexpRepPtr->refCount-- <= 1) {
FreeRegexp(regexpRepPtr);
}
- objPtr->typePtr = NULL;
}
/*
@@ -790,11 +792,13 @@ DupRegexpInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ TclRegexp *regexpPtr;
+
+ RegexpGetIntRep(srcPtr, regexpPtr);
+
+ assert(regexpPtr != NULL);
- regexpPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->typePtr = &tclRegexpType;
+ RegexpSetIntRep(copyPtr, regexpPtr);
}
/*
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 6a1311f..745f05b 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -1009,8 +1009,10 @@ Tcl_ScanObjCmd(
double dvalue;
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (objPtr->typePtr == &tclDoubleType) {
- dvalue = objPtr->internalRep.doubleValue;
+ const Tcl_ObjIntRep *irPtr
+ = Tcl_FetchIntRep(objPtr, &tclDoubleType);
+ if (irPtr) {
+ dvalue = irPtr->doubleValue;
} else
#endif
{
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index a46b29a..a46b29a 100644..100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index fa55bb0..7be74ca 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -4211,7 +4211,7 @@ UpdateStringOfString(
stringPtr->allocated = 0;
if (stringPtr->numChars == 0) {
- TclInitStringRep(objPtr, &tclEmptyString, 0);
+ TclInitStringRep(objPtr, NULL, 0);
} else {
(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
stringPtr->numChars);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 6a4eabc..4c9d3e8 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -1581,6 +1581,11 @@ const TclStubs tclStubs = {
TclZipfs_Unmount, /* 633 */
TclZipfs_TclLibrary, /* 634 */
TclZipfs_MountBuffer, /* 635 */
+ Tcl_FreeIntRep, /* 636 */
+ Tcl_InitStringRep, /* 637 */
+ Tcl_FetchIntRep, /* 638 */
+ Tcl_StoreIntRep, /* 639 */
+ Tcl_HasStringRep, /* 640 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 2cdd356..fb8857c 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7082,17 +7082,11 @@ TestconcatobjCmd(
list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
Tcl_ListObjLength(NULL, list1Ptr, &len);
- if (list1Ptr->bytes != NULL) {
- ckfree(list1Ptr->bytes);
- list1Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringRep(list1Ptr);
list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
Tcl_ListObjLength(NULL, list2Ptr, &len);
- if (list2Ptr->bytes != NULL) {
- ckfree(list2Ptr->bytes);
- list2Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringRep(list2Ptr);
/*
* Verify that concat'ing a list obj with one or more empty strings does
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 54854d0..ccfd179 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -789,7 +789,7 @@ Tcl_AfterObjCmd(
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
int length;
- int index;
+ int index = -1;
static const char *const afterSubCmds[] = {
"cancel", "idle", "info", NULL
};
@@ -818,12 +818,9 @@ Tcl_AfterObjCmd(
* First lets see if the command was passed a number as the first argument.
*/
- if (objv[1]->typePtr == &tclIntType
- || objv[1]->typePtr == &tclBignumType
- || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
- &index) != TCL_OK)) {
- index = -1;
- if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
+ != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 76a3890..ef3c3dc 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1390,9 +1390,9 @@ TclConvertElement(
*/
if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
- src = &tclEmptyString;
- length = 0;
- conversion = CONVERT_BRACE;
+ p[0] = '{';
+ p[1] = '}';
+ return 2;
}
/*
@@ -2089,7 +2089,7 @@ Tcl_ConcatObj(
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
- if (objPtr->bytes && objPtr->length == 0) {
+ if (!TclListObjIsCanonical(objPtr)) {
continue;
}
if (resPtr) {
@@ -3903,20 +3903,19 @@ TclGetIntForIndex(
}
return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
* GetEndOffsetFromObj --
*
- * Look for a string of the form "end[+-]offset" and convert it to an
- * internal representation holding the offset.
+ * Look for a string of the form "end[+-]offset" and convert it to an
+ * internal representation holding the offset.
*
* Results:
- * Tcl return code.
+ * Tcl return code.
*
* Side effects:
- * May store a Tcl_ObjType.
+ * May store a Tcl_ObjType.
*
*----------------------------------------------------------------------
*/
@@ -3929,9 +3928,11 @@ GetEndOffsetFromObj(
Tcl_WideInt *widePtr) /* Location filled in with an integer
* representing an index. */
{
+ Tcl_ObjIntRep *irPtr;
Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */
- if (objPtr->typePtr != &endOffsetType) {
+ while ((irPtr = Tcl_FetchIntRep(objPtr, &endOffsetType)) == NULL) {
+ Tcl_ObjIntRep ir;
int length;
const char *bytes = TclGetStringFromObj(objPtr, &length);
@@ -3985,13 +3986,12 @@ GetEndOffsetFromObj(
}
}
- /* Success. Free the old internal rep and set the new one. */
- TclFreeIntRep(objPtr);
- objPtr->internalRep.wideValue = offset;
- objPtr->typePtr = &endOffsetType;
+ /* Success. Store the new internal rep. */
+ ir.wideValue = offset;
+ Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
}
- offset = objPtr->internalRep.wideValue;
+ offset = irPtr->wideValue;
if ((endValue ^ offset) < 0) {
/* Different signs, sum cannot overflow */
diff --git a/generic/tclVar.c b/generic/tclVar.c
index cafa6a3..dfe883f 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -254,10 +254,49 @@ static const Tcl_ObjType localVarNameType = {
FreeLocalVarName, DupLocalVarName, NULL, NULL
};
-static const Tcl_ObjType tclParsedVarNameType = {
+#define LocalSetIntRep(objPtr, index, namePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ Tcl_Obj *ptr = (namePtr); \
+ if (ptr) {Tcl_IncrRefCount(ptr);} \
+ ir.twoPtrValue.ptr1 = ptr; \
+ ir.twoPtrValue.ptr2 = INT2PTR(index); \
+ Tcl_StoreIntRep((objPtr), &localVarNameType, &ir); \
+ } while (0)
+
+#define LocalGetIntRep(objPtr, index, name) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &localVarNameType); \
+ (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \
+ } while (0)
+
+static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
FreeParsedVarName, DupParsedVarName, NULL, NULL
};
+
+#define ParsedSetIntRep(objPtr, arrayPtr, elem) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ Tcl_Obj *ptr1 = (arrayPtr); \
+ Tcl_Obj *ptr2 = (elem); \
+ if (ptr1) {Tcl_IncrRefCount(ptr1);} \
+ if (ptr2) {Tcl_IncrRefCount(ptr2);} \
+ ir.twoPtrValue.ptr1 = ptr1; \
+ ir.twoPtrValue.ptr2 = ptr2; \
+ Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir); \
+ } while (0)
+
+#define ParsedGetIntRep(objPtr, parsed, array, elem) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = Tcl_FetchIntRep((objPtr), &parsedVarNameType); \
+ (parsed) = (irPtr != NULL); \
+ (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \
+ } while (0)
Var *
TclVarHashCreateVar(
@@ -482,9 +521,8 @@ TclLookupVar(
*
* Side effects:
* New hashtable entries may be created if createPart1 or createPart2
- * are 1. The object part1Ptr is converted to one of localVarNameType,
- * tclNsVarNameType or tclParsedVarNameType and caches as much of the
- * lookup as it can.
+ * are 1. The object part1Ptr is converted to one of localVarNameType
+ * or parsedVarNameType and caches as much of the lookup as it can.
* When createPart1 is 1, callers must IncrRefCount part1Ptr if they
* plan to DecrRefCount it.
*
@@ -571,15 +609,15 @@ TclObjLookupVarEx(
* structure. */
const char *errMsg = NULL;
int index, parsed = 0;
- const Tcl_ObjType *typePtr = part1Ptr->typePtr;
- *arrayPtrPtr = NULL;
+ int localIndex;
+ Tcl_Obj *namePtr, *arrayPtr, *elem;
- if (typePtr == &localVarNameType) {
- int localIndex;
+ *arrayPtrPtr = NULL;
- localVarNameTypeHandling:
- localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
+ restart:
+ LocalGetIntRep(part1Ptr, localIndex, namePtr);
+ if (localIndex >= 0) {
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -587,7 +625,6 @@ TclObjLookupVarEx(
* Use the cached index if the names coincide.
*/
- Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);
if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -600,12 +637,11 @@ TclObjLookupVarEx(
}
/*
- * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
- * parts.
+ * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
*/
- if (typePtr == &tclParsedVarNameType) {
- if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
+ ParsedGetIntRep(part1Ptr, parsed, arrayPtr, elem);
+ if (parsed && arrayPtr) {
if (part2Ptr != NULL) {
/*
* ERROR: part1Ptr is already an array element, cannot specify
@@ -619,14 +655,9 @@ TclObjLookupVarEx(
}
return NULL;
}
- part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2;
- part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
- typePtr = part1Ptr->typePtr;
- if (typePtr == &localVarNameType) {
- goto localVarNameTypeHandling;
- }
- }
- parsed = 1;
+ part2Ptr = elem;
+ part1Ptr = arrayPtr;
+ goto restart;
}
if (!parsed) {
@@ -641,8 +672,6 @@ TclObjLookupVarEx(
const char *part2 = strchr(part1, '(');
if (part2) {
- Tcl_Obj *arrayPtr;
-
if (part2Ptr != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
@@ -657,13 +686,7 @@ TclObjLookupVarEx(
part2Ptr = Tcl_NewStringObj(part2 + 1,
len - (part2 - part1) - 2);
- TclFreeIntRep(part1Ptr);
-
- Tcl_IncrRefCount(arrayPtr);
- part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
- Tcl_IncrRefCount(part2Ptr);
- part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
- part1Ptr->typePtr = &tclParsedVarNameType;
+ ParsedSetIntRep(part1Ptr, arrayPtr, part2Ptr);
part1Ptr = arrayPtr;
}
@@ -691,7 +714,6 @@ TclObjLookupVarEx(
* Cache the newly found variable if possible.
*/
- TclFreeIntRep(part1Ptr);
if (index >= 0) {
/*
* An indexed local variable.
@@ -699,26 +721,36 @@ TclObjLookupVarEx(
Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
- part1Ptr->typePtr = &localVarNameType;
- if (part1Ptr != cachedNamePtr) {
- part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
- Tcl_IncrRefCount(cachedNamePtr);
- if (cachedNamePtr->typePtr != &localVarNameType
- || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
- TclFreeIntRep(cachedNamePtr);
- }
+ if (part1Ptr == cachedNamePtr) {
+ cachedNamePtr = NULL;
} else {
- part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
+ /*
+ * [80304238ac] Trickiness here. We will store and incr the
+ * refcount on cachedNamePtr. Trouble is that it's possible
+ * (see test var-22.1) for cachedNamePtr to have an intrep
+ * that contains a stored and refcounted part1Ptr. This
+ * would be a reference cycle which leads to a memory leak.
+ *
+ * The solution here is to wipe away all intrep(s) in
+ * cachedNamePtr and leave it as string only. This is
+ * radical and destructive, so a better idea would be welcome.
+ */
+ TclFreeIntRep(cachedNamePtr);
+
+ /*
+ * Now go ahead and convert it the the "localVarName" type,
+ * since we suspect at least some use of the value as a
+ * varname and we want to resolve it quickly.
+ */
+ LocalSetIntRep(cachedNamePtr, index, NULL);
}
- part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
+ LocalSetIntRep(part1Ptr, index, cachedNamePtr);
} else {
/*
* At least mark part1Ptr as already parsed.
*/
- part1Ptr->typePtr = &tclParsedVarNameType;
- part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
- part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
+ ParsedSetIntRep(part1Ptr, NULL, NULL);
}
donePart1:
@@ -5764,12 +5796,15 @@ static void
FreeLocalVarName(
Tcl_Obj *objPtr)
{
- Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ int index;
+ Tcl_Obj *namePtr;
+
+ LocalGetIntRep(objPtr, index, namePtr);
+ index++; /* Compiler warning bait. */
if (namePtr) {
Tcl_DecrRefCount(namePtr);
}
- objPtr->typePtr = NULL;
}
static void
@@ -5777,17 +5812,14 @@ DupLocalVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ int index;
+ Tcl_Obj *namePtr;
+ LocalGetIntRep(srcPtr, index, namePtr);
if (!namePtr) {
namePtr = srcPtr;
}
- dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
- Tcl_IncrRefCount(namePtr);
-
- dupPtr->internalRep.twoPtrValue.ptr2 =
- srcPtr->internalRep.twoPtrValue.ptr2;
- dupPtr->typePtr = &localVarNameType;
+ LocalSetIntRep(dupPtr, index, namePtr);
}
/*
@@ -5803,14 +5835,16 @@ static void
FreeParsedVarName(
Tcl_Obj *objPtr)
{
- register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2;
+ register Tcl_Obj *arrayPtr, *elem;
+ int parsed;
+
+ ParsedGetIntRep(objPtr, parsed, arrayPtr, elem);
+ parsed++; /* Silence compiler. */
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
TclDecrRefCount(elem);
}
- objPtr->typePtr = NULL;
}
static void
@@ -5818,17 +5852,13 @@ DupParsedVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2;
+ register Tcl_Obj *arrayPtr, *elem;
+ int parsed;
- if (arrayPtr != NULL) {
- Tcl_IncrRefCount(arrayPtr);
- Tcl_IncrRefCount(elem);
- }
+ ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem);
- dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
- dupPtr->internalRep.twoPtrValue.ptr2 = elem;
- dupPtr->typePtr = &tclParsedVarNameType;
+ parsed++; /* Silence compiler. */
+ ParsedSetIntRep(dupPtr, arrayPtr, elem);
}
/*
diff --git a/library/clock.tcl b/library/clock.tcl
index 8e4b657..8e4b657 100644..100755
--- a/library/clock.tcl
+++ b/library/clock.tcl
diff --git a/library/encoding/tis-620.enc b/library/encoding/tis-620.enc
index c233be5..c233be5 100644..100755
--- a/library/encoding/tis-620.enc
+++ b/library/encoding/tis-620.enc
diff --git a/library/msgs/af.msg b/library/msgs/af.msg
index 0892615..0892615 100644..100755
--- a/library/msgs/af.msg
+++ b/library/msgs/af.msg
diff --git a/library/msgs/af_za.msg b/library/msgs/af_za.msg
index fef48ad..fef48ad 100644..100755
--- a/library/msgs/af_za.msg
+++ b/library/msgs/af_za.msg
diff --git a/library/msgs/ar.msg b/library/msgs/ar.msg
index 2d403ec..2d403ec 100644..100755
--- a/library/msgs/ar.msg
+++ b/library/msgs/ar.msg
diff --git a/library/msgs/ar_in.msg b/library/msgs/ar_in.msg
index 185e49c..185e49c 100644..100755
--- a/library/msgs/ar_in.msg
+++ b/library/msgs/ar_in.msg
diff --git a/library/msgs/ar_jo.msg b/library/msgs/ar_jo.msg
index 9a9dda0..9a9dda0 100644..100755
--- a/library/msgs/ar_jo.msg
+++ b/library/msgs/ar_jo.msg
diff --git a/library/msgs/ar_lb.msg b/library/msgs/ar_lb.msg
index c23aa2c..c23aa2c 100644..100755
--- a/library/msgs/ar_lb.msg
+++ b/library/msgs/ar_lb.msg
diff --git a/library/msgs/ar_sy.msg b/library/msgs/ar_sy.msg
index f0daec0..f0daec0 100644..100755
--- a/library/msgs/ar_sy.msg
+++ b/library/msgs/ar_sy.msg
diff --git a/library/msgs/be.msg b/library/msgs/be.msg
index a0aceed..a0aceed 100644..100755
--- a/library/msgs/be.msg
+++ b/library/msgs/be.msg
diff --git a/library/msgs/bg.msg b/library/msgs/bg.msg
index 2e7730d..2e7730d 100644..100755
--- a/library/msgs/bg.msg
+++ b/library/msgs/bg.msg
diff --git a/library/msgs/bn.msg b/library/msgs/bn.msg
index a0aef13..a0aef13 100644..100755
--- a/library/msgs/bn.msg
+++ b/library/msgs/bn.msg
diff --git a/library/msgs/bn_in.msg b/library/msgs/bn_in.msg
index 28c000f..28c000f 100644..100755
--- a/library/msgs/bn_in.msg
+++ b/library/msgs/bn_in.msg
diff --git a/library/msgs/ca.msg b/library/msgs/ca.msg
index 272f682..272f682 100644..100755
--- a/library/msgs/ca.msg
+++ b/library/msgs/ca.msg
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index 4673cd4..4673cd4 100644..100755
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index abed3c5..abed3c5 100644..100755
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 0bb7399..0bb7399 100644..100755
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
diff --git a/library/msgs/de_at.msg b/library/msgs/de_at.msg
index 1a0a0f5..1a0a0f5 100644..100755
--- a/library/msgs/de_at.msg
+++ b/library/msgs/de_at.msg
diff --git a/library/msgs/de_be.msg b/library/msgs/de_be.msg
index 04cf88c..04cf88c 100644..100755
--- a/library/msgs/de_be.msg
+++ b/library/msgs/de_be.msg
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index 26bdfe9..26bdfe9 100644..100755
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
diff --git a/library/msgs/en_au.msg b/library/msgs/en_au.msg
index 7f9870c..7f9870c 100644..100755
--- a/library/msgs/en_au.msg
+++ b/library/msgs/en_au.msg
diff --git a/library/msgs/en_be.msg b/library/msgs/en_be.msg
index 5072986..5072986 100644..100755
--- a/library/msgs/en_be.msg
+++ b/library/msgs/en_be.msg
diff --git a/library/msgs/en_bw.msg b/library/msgs/en_bw.msg
index 8fd20c7..8fd20c7 100644..100755
--- a/library/msgs/en_bw.msg
+++ b/library/msgs/en_bw.msg
diff --git a/library/msgs/en_ca.msg b/library/msgs/en_ca.msg
index 278efe7..278efe7 100644..100755
--- a/library/msgs/en_ca.msg
+++ b/library/msgs/en_ca.msg
diff --git a/library/msgs/en_gb.msg b/library/msgs/en_gb.msg
index 5c61c43..5c61c43 100644..100755
--- a/library/msgs/en_gb.msg
+++ b/library/msgs/en_gb.msg
diff --git a/library/msgs/en_hk.msg b/library/msgs/en_hk.msg
index 8b33bc0..8b33bc0 100644..100755
--- a/library/msgs/en_hk.msg
+++ b/library/msgs/en_hk.msg
diff --git a/library/msgs/en_ie.msg b/library/msgs/en_ie.msg
index ba621cf..ba621cf 100644..100755
--- a/library/msgs/en_ie.msg
+++ b/library/msgs/en_ie.msg
diff --git a/library/msgs/en_in.msg b/library/msgs/en_in.msg
index a1f155d..a1f155d 100644..100755
--- a/library/msgs/en_in.msg
+++ b/library/msgs/en_in.msg
diff --git a/library/msgs/en_nz.msg b/library/msgs/en_nz.msg
index b419017..b419017 100644..100755
--- a/library/msgs/en_nz.msg
+++ b/library/msgs/en_nz.msg
diff --git a/library/msgs/en_ph.msg b/library/msgs/en_ph.msg
index 682666d..682666d 100644..100755
--- a/library/msgs/en_ph.msg
+++ b/library/msgs/en_ph.msg
diff --git a/library/msgs/en_sg.msg b/library/msgs/en_sg.msg
index 4dc5b1d..4dc5b1d 100644..100755
--- a/library/msgs/en_sg.msg
+++ b/library/msgs/en_sg.msg
diff --git a/library/msgs/en_za.msg b/library/msgs/en_za.msg
index fe43797..fe43797 100644..100755
--- a/library/msgs/en_za.msg
+++ b/library/msgs/en_za.msg
diff --git a/library/msgs/en_zw.msg b/library/msgs/en_zw.msg
index 2a5804f..2a5804f 100644..100755
--- a/library/msgs/en_zw.msg
+++ b/library/msgs/en_zw.msg
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index b9b1500..b9b1500 100644..100755
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index 6090eab..6090eab 100644..100755
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
diff --git a/library/msgs/es_ar.msg b/library/msgs/es_ar.msg
index 7d35027..7d35027 100644..100755
--- a/library/msgs/es_ar.msg
+++ b/library/msgs/es_ar.msg
diff --git a/library/msgs/es_bo.msg b/library/msgs/es_bo.msg
index 498ad0d..498ad0d 100644..100755
--- a/library/msgs/es_bo.msg
+++ b/library/msgs/es_bo.msg
diff --git a/library/msgs/es_cl.msg b/library/msgs/es_cl.msg
index 31d465c..31d465c 100644..100755
--- a/library/msgs/es_cl.msg
+++ b/library/msgs/es_cl.msg
diff --git a/library/msgs/es_co.msg b/library/msgs/es_co.msg
index 77e57f0..77e57f0 100644..100755
--- a/library/msgs/es_co.msg
+++ b/library/msgs/es_co.msg
diff --git a/library/msgs/es_cr.msg b/library/msgs/es_cr.msg
index 7a652fa..7a652fa 100644..100755
--- a/library/msgs/es_cr.msg
+++ b/library/msgs/es_cr.msg
diff --git a/library/msgs/es_do.msg b/library/msgs/es_do.msg
index 0e283da..0e283da 100644..100755
--- a/library/msgs/es_do.msg
+++ b/library/msgs/es_do.msg
diff --git a/library/msgs/es_ec.msg b/library/msgs/es_ec.msg
index 9e921e0..9e921e0 100644..100755
--- a/library/msgs/es_ec.msg
+++ b/library/msgs/es_ec.msg
diff --git a/library/msgs/es_gt.msg b/library/msgs/es_gt.msg
index ecd6faf..ecd6faf 100644..100755
--- a/library/msgs/es_gt.msg
+++ b/library/msgs/es_gt.msg
diff --git a/library/msgs/es_hn.msg b/library/msgs/es_hn.msg
index a758ca2..a758ca2 100644..100755
--- a/library/msgs/es_hn.msg
+++ b/library/msgs/es_hn.msg
diff --git a/library/msgs/es_mx.msg b/library/msgs/es_mx.msg
index 7cfb545..7cfb545 100644..100755
--- a/library/msgs/es_mx.msg
+++ b/library/msgs/es_mx.msg
diff --git a/library/msgs/es_ni.msg b/library/msgs/es_ni.msg
index 7c39495..7c39495 100644..100755
--- a/library/msgs/es_ni.msg
+++ b/library/msgs/es_ni.msg
diff --git a/library/msgs/es_pa.msg b/library/msgs/es_pa.msg
index cecacdc..cecacdc 100644..100755
--- a/library/msgs/es_pa.msg
+++ b/library/msgs/es_pa.msg
diff --git a/library/msgs/es_pe.msg b/library/msgs/es_pe.msg
index 9f90595..9f90595 100644..100755
--- a/library/msgs/es_pe.msg
+++ b/library/msgs/es_pe.msg
diff --git a/library/msgs/es_pr.msg b/library/msgs/es_pr.msg
index 8511b12..8511b12 100644..100755
--- a/library/msgs/es_pr.msg
+++ b/library/msgs/es_pr.msg
diff --git a/library/msgs/es_py.msg b/library/msgs/es_py.msg
index aa93d36..aa93d36 100644..100755
--- a/library/msgs/es_py.msg
+++ b/library/msgs/es_py.msg
diff --git a/library/msgs/es_sv.msg b/library/msgs/es_sv.msg
index fc7954d..fc7954d 100644..100755
--- a/library/msgs/es_sv.msg
+++ b/library/msgs/es_sv.msg
diff --git a/library/msgs/es_uy.msg b/library/msgs/es_uy.msg
index b33525c..b33525c 100644..100755
--- a/library/msgs/es_uy.msg
+++ b/library/msgs/es_uy.msg
diff --git a/library/msgs/es_ve.msg b/library/msgs/es_ve.msg
index 7c2a7b0..7c2a7b0 100644..100755
--- a/library/msgs/es_ve.msg
+++ b/library/msgs/es_ve.msg
diff --git a/library/msgs/et.msg b/library/msgs/et.msg
index a782f9b..a782f9b 100644..100755
--- a/library/msgs/et.msg
+++ b/library/msgs/et.msg
diff --git a/library/msgs/eu.msg b/library/msgs/eu.msg
index cf708b6..cf708b6 100644..100755
--- a/library/msgs/eu.msg
+++ b/library/msgs/eu.msg
diff --git a/library/msgs/eu_es.msg b/library/msgs/eu_es.msg
index 2694418..2694418 100644..100755
--- a/library/msgs/eu_es.msg
+++ b/library/msgs/eu_es.msg
diff --git a/library/msgs/fa.msg b/library/msgs/fa.msg
index 6166e28..6166e28 100644..100755
--- a/library/msgs/fa.msg
+++ b/library/msgs/fa.msg
diff --git a/library/msgs/fa_in.msg b/library/msgs/fa_in.msg
index ce32f99..ce32f99 100644..100755
--- a/library/msgs/fa_in.msg
+++ b/library/msgs/fa_in.msg
diff --git a/library/msgs/fa_ir.msg b/library/msgs/fa_ir.msg
index 9ce9284..9ce9284 100644..100755
--- a/library/msgs/fa_ir.msg
+++ b/library/msgs/fa_ir.msg
diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg
index 69be367..69be367 100644..100755
--- a/library/msgs/fi.msg
+++ b/library/msgs/fi.msg
diff --git a/library/msgs/fo.msg b/library/msgs/fo.msg
index 1f1794d..1f1794d 100644..100755
--- a/library/msgs/fo.msg
+++ b/library/msgs/fo.msg
diff --git a/library/msgs/fo_fo.msg b/library/msgs/fo_fo.msg
index 2392b8e..2392b8e 100644..100755
--- a/library/msgs/fo_fo.msg
+++ b/library/msgs/fo_fo.msg
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index a274468..a274468 100644..100755
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
diff --git a/library/msgs/fr_be.msg b/library/msgs/fr_be.msg
index cdb13bd..cdb13bd 100644..100755
--- a/library/msgs/fr_be.msg
+++ b/library/msgs/fr_be.msg
diff --git a/library/msgs/fr_ca.msg b/library/msgs/fr_ca.msg
index 00ccfff..00ccfff 100644..100755
--- a/library/msgs/fr_ca.msg
+++ b/library/msgs/fr_ca.msg
diff --git a/library/msgs/fr_ch.msg b/library/msgs/fr_ch.msg
index 7e2bac7..7e2bac7 100644..100755
--- a/library/msgs/fr_ch.msg
+++ b/library/msgs/fr_ch.msg
diff --git a/library/msgs/ga.msg b/library/msgs/ga.msg
index 056c9a0..056c9a0 100644..100755
--- a/library/msgs/ga.msg
+++ b/library/msgs/ga.msg
diff --git a/library/msgs/ga_ie.msg b/library/msgs/ga_ie.msg
index b6acbbc..b6acbbc 100644..100755
--- a/library/msgs/ga_ie.msg
+++ b/library/msgs/ga_ie.msg
diff --git a/library/msgs/gl.msg b/library/msgs/gl.msg
index c2fefc9..c2fefc9 100644..100755
--- a/library/msgs/gl.msg
+++ b/library/msgs/gl.msg
diff --git a/library/msgs/gl_es.msg b/library/msgs/gl_es.msg
index d4ed270..d4ed270 100644..100755
--- a/library/msgs/gl_es.msg
+++ b/library/msgs/gl_es.msg
diff --git a/library/msgs/gv.msg b/library/msgs/gv.msg
index 7d332ad..7d332ad 100644..100755
--- a/library/msgs/gv.msg
+++ b/library/msgs/gv.msg
diff --git a/library/msgs/gv_gb.msg b/library/msgs/gv_gb.msg
index 5e96e6f..5e96e6f 100644..100755
--- a/library/msgs/gv_gb.msg
+++ b/library/msgs/gv_gb.msg
diff --git a/library/msgs/he.msg b/library/msgs/he.msg
index 13a81b7..13a81b7 100644..100755
--- a/library/msgs/he.msg
+++ b/library/msgs/he.msg
diff --git a/library/msgs/hi.msg b/library/msgs/hi.msg
index 18c8bf0..18c8bf0 100644..100755
--- a/library/msgs/hi.msg
+++ b/library/msgs/hi.msg
diff --git a/library/msgs/hi_in.msg b/library/msgs/hi_in.msg
index 239793f..239793f 100644..100755
--- a/library/msgs/hi_in.msg
+++ b/library/msgs/hi_in.msg
diff --git a/library/msgs/hr.msg b/library/msgs/hr.msg
index 30491e1..30491e1 100644..100755
--- a/library/msgs/hr.msg
+++ b/library/msgs/hr.msg
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index 46776dd..46776dd 100644..100755
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
diff --git a/library/msgs/id.msg b/library/msgs/id.msg
index 17c6bb5..17c6bb5 100644..100755
--- a/library/msgs/id.msg
+++ b/library/msgs/id.msg
diff --git a/library/msgs/id_id.msg b/library/msgs/id_id.msg
index bb672c1..bb672c1 100644..100755
--- a/library/msgs/id_id.msg
+++ b/library/msgs/id_id.msg
diff --git a/library/msgs/is.msg b/library/msgs/is.msg
index a369b89..a369b89 100644..100755
--- a/library/msgs/is.msg
+++ b/library/msgs/is.msg
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index e51aee2..e51aee2 100644..100755
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
diff --git a/library/msgs/it_ch.msg b/library/msgs/it_ch.msg
index b36ed36..b36ed36 100644..100755
--- a/library/msgs/it_ch.msg
+++ b/library/msgs/it_ch.msg
diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg
index 76b5fa4..76b5fa4 100644..100755
--- a/library/msgs/ja.msg
+++ b/library/msgs/ja.msg
diff --git a/library/msgs/kl.msg b/library/msgs/kl.msg
index d877bfe..d877bfe 100644..100755
--- a/library/msgs/kl.msg
+++ b/library/msgs/kl.msg
diff --git a/library/msgs/kl_gl.msg b/library/msgs/kl_gl.msg
index 403aa10..403aa10 100644..100755
--- a/library/msgs/kl_gl.msg
+++ b/library/msgs/kl_gl.msg
diff --git a/library/msgs/ko.msg b/library/msgs/ko.msg
index 817c2e7..817c2e7 100644..100755
--- a/library/msgs/ko.msg
+++ b/library/msgs/ko.msg
diff --git a/library/msgs/ko_kr.msg b/library/msgs/ko_kr.msg
index f23bd6b..f23bd6b 100644..100755
--- a/library/msgs/ko_kr.msg
+++ b/library/msgs/ko_kr.msg
diff --git a/library/msgs/kok.msg b/library/msgs/kok.msg
index 231853b..231853b 100644..100755
--- a/library/msgs/kok.msg
+++ b/library/msgs/kok.msg
diff --git a/library/msgs/kok_in.msg b/library/msgs/kok_in.msg
index abcb1ff..abcb1ff 100644..100755
--- a/library/msgs/kok_in.msg
+++ b/library/msgs/kok_in.msg
diff --git a/library/msgs/kw.msg b/library/msgs/kw.msg
index aaf79b3..aaf79b3 100644..100755
--- a/library/msgs/kw.msg
+++ b/library/msgs/kw.msg
diff --git a/library/msgs/kw_gb.msg b/library/msgs/kw_gb.msg
index 2967680..2967680 100644..100755
--- a/library/msgs/kw_gb.msg
+++ b/library/msgs/kw_gb.msg
diff --git a/library/msgs/lt.msg b/library/msgs/lt.msg
index 15829a9..15829a9 100644..100755
--- a/library/msgs/lt.msg
+++ b/library/msgs/lt.msg
diff --git a/library/msgs/lv.msg b/library/msgs/lv.msg
index 730fd33..730fd33 100644..100755
--- a/library/msgs/lv.msg
+++ b/library/msgs/lv.msg
diff --git a/library/msgs/mk.msg b/library/msgs/mk.msg
index 9b7bd9d..9b7bd9d 100644..100755
--- a/library/msgs/mk.msg
+++ b/library/msgs/mk.msg
diff --git a/library/msgs/mr.msg b/library/msgs/mr.msg
index e475615..e475615 100644..100755
--- a/library/msgs/mr.msg
+++ b/library/msgs/mr.msg
diff --git a/library/msgs/mr_in.msg b/library/msgs/mr_in.msg
index 1889da5..1889da5 100644..100755
--- a/library/msgs/mr_in.msg
+++ b/library/msgs/mr_in.msg
diff --git a/library/msgs/ms.msg b/library/msgs/ms.msg
index e954431..e954431 100644..100755
--- a/library/msgs/ms.msg
+++ b/library/msgs/ms.msg
diff --git a/library/msgs/ms_my.msg b/library/msgs/ms_my.msg
index c1f93d4..c1f93d4 100644..100755
--- a/library/msgs/ms_my.msg
+++ b/library/msgs/ms_my.msg
diff --git a/library/msgs/mt.msg b/library/msgs/mt.msg
index c479e47..c479e47 100644..100755
--- a/library/msgs/mt.msg
+++ b/library/msgs/mt.msg
diff --git a/library/msgs/nb.msg b/library/msgs/nb.msg
index 4dd76c7..4dd76c7 100644..100755
--- a/library/msgs/nb.msg
+++ b/library/msgs/nb.msg
diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg
index 4c5c675..4c5c675 100644..100755
--- a/library/msgs/nl.msg
+++ b/library/msgs/nl.msg
diff --git a/library/msgs/nl_be.msg b/library/msgs/nl_be.msg
index 4b19670..4b19670 100644..100755
--- a/library/msgs/nl_be.msg
+++ b/library/msgs/nl_be.msg
diff --git a/library/msgs/nn.msg b/library/msgs/nn.msg
index b61a2dd..b61a2dd 100644..100755
--- a/library/msgs/nn.msg
+++ b/library/msgs/nn.msg
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index 821eea7..821eea7 100644..100755
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 425c1f6..425c1f6 100644..100755
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
diff --git a/library/msgs/pt_br.msg b/library/msgs/pt_br.msg
index 8684327..8684327 100644..100755
--- a/library/msgs/pt_br.msg
+++ b/library/msgs/pt_br.msg
diff --git a/library/msgs/ro.msg b/library/msgs/ro.msg
index f4452ba..f4452ba 100644..100755
--- a/library/msgs/ro.msg
+++ b/library/msgs/ro.msg
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 983a253..983a253 100644..100755
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
diff --git a/library/msgs/ru_ua.msg b/library/msgs/ru_ua.msg
index 6e1f8a8..6e1f8a8 100644..100755
--- a/library/msgs/ru_ua.msg
+++ b/library/msgs/ru_ua.msg
diff --git a/library/msgs/sh.msg b/library/msgs/sh.msg
index 2e4143d..2e4143d 100644..100755
--- a/library/msgs/sh.msg
+++ b/library/msgs/sh.msg
diff --git a/library/msgs/sk.msg b/library/msgs/sk.msg
index dc6f6b6..dc6f6b6 100644..100755
--- a/library/msgs/sk.msg
+++ b/library/msgs/sk.msg
diff --git a/library/msgs/sl.msg b/library/msgs/sl.msg
index 2ee0a03..2ee0a03 100644..100755
--- a/library/msgs/sl.msg
+++ b/library/msgs/sl.msg
diff --git a/library/msgs/sq.msg b/library/msgs/sq.msg
index 65da407..65da407 100644..100755
--- a/library/msgs/sq.msg
+++ b/library/msgs/sq.msg
diff --git a/library/msgs/sr.msg b/library/msgs/sr.msg
index 3d84d6c..3d84d6c 100644..100755
--- a/library/msgs/sr.msg
+++ b/library/msgs/sr.msg
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index 5716092..5716092 100644..100755
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
diff --git a/library/msgs/sw.msg b/library/msgs/sw.msg
index b888b43..b888b43 100644..100755
--- a/library/msgs/sw.msg
+++ b/library/msgs/sw.msg
diff --git a/library/msgs/ta.msg b/library/msgs/ta.msg
index ea62552..ea62552 100644..100755
--- a/library/msgs/ta.msg
+++ b/library/msgs/ta.msg
diff --git a/library/msgs/ta_in.msg b/library/msgs/ta_in.msg
index 24590ac..24590ac 100644..100755
--- a/library/msgs/ta_in.msg
+++ b/library/msgs/ta_in.msg
diff --git a/library/msgs/te.msg b/library/msgs/te.msg
index f35ece4..f35ece4 100644..100755
--- a/library/msgs/te.msg
+++ b/library/msgs/te.msg
diff --git a/library/msgs/te_in.msg b/library/msgs/te_in.msg
index 84dd2b3..84dd2b3 100644..100755
--- a/library/msgs/te_in.msg
+++ b/library/msgs/te_in.msg
diff --git a/library/msgs/th.msg b/library/msgs/th.msg
index edaa149..edaa149 100644..100755
--- a/library/msgs/th.msg
+++ b/library/msgs/th.msg
diff --git a/library/msgs/tr.msg b/library/msgs/tr.msg
index 12869ee..12869ee 100644..100755
--- a/library/msgs/tr.msg
+++ b/library/msgs/tr.msg
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 42eb095..42eb095 100644..100755
--- a/library/msgs/uk.msg
+++ b/library/msgs/uk.msg
diff --git a/library/msgs/vi.msg b/library/msgs/vi.msg
index 3437ebf..3437ebf 100644..100755
--- a/library/msgs/vi.msg
+++ b/library/msgs/vi.msg
diff --git a/library/msgs/zh.msg b/library/msgs/zh.msg
index 9c1d08b..9c1d08b 100644..100755
--- a/library/msgs/zh.msg
+++ b/library/msgs/zh.msg
diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg
index da2869a..da2869a 100644..100755
--- a/library/msgs/zh_cn.msg
+++ b/library/msgs/zh_cn.msg
diff --git a/library/msgs/zh_hk.msg b/library/msgs/zh_hk.msg
index 7f1b181..7f1b181 100644..100755
--- a/library/msgs/zh_hk.msg
+++ b/library/msgs/zh_hk.msg
diff --git a/library/msgs/zh_sg.msg b/library/msgs/zh_sg.msg
index 690edf7..690edf7 100644..100755
--- a/library/msgs/zh_sg.msg
+++ b/library/msgs/zh_sg.msg
diff --git a/library/msgs/zh_tw.msg b/library/msgs/zh_tw.msg
index 17a6dd7..17a6dd7 100644..100755
--- a/library/msgs/zh_tw.msg
+++ b/library/msgs/zh_tw.msg
diff --git a/library/tzdata/Africa/Asmara b/library/tzdata/Africa/Asmara
index 3d33c94..3d33c94 100644..100755
--- a/library/tzdata/Africa/Asmara
+++ b/library/tzdata/Africa/Asmara
diff --git a/library/tzdata/America/Atikokan b/library/tzdata/America/Atikokan
index e72b04f..e72b04f 100644..100755
--- a/library/tzdata/America/Atikokan
+++ b/library/tzdata/America/Atikokan
diff --git a/library/tzdata/America/Blanc-Sablon b/library/tzdata/America/Blanc-Sablon
index d5485e8..d5485e8 100644..100755
--- a/library/tzdata/America/Blanc-Sablon
+++ b/library/tzdata/America/Blanc-Sablon
diff --git a/library/tzdata/America/Indiana/Petersburg b/library/tzdata/America/Indiana/Petersburg
index 6992bfc..6992bfc 100644..100755
--- a/library/tzdata/America/Indiana/Petersburg
+++ b/library/tzdata/America/Indiana/Petersburg
diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City
index 9eebcf7..9eebcf7 100644..100755
--- a/library/tzdata/America/Indiana/Tell_City
+++ b/library/tzdata/America/Indiana/Tell_City
diff --git a/library/tzdata/America/Indiana/Vincennes b/library/tzdata/America/Indiana/Vincennes
index 1af7fc9..1af7fc9 100644..100755
--- a/library/tzdata/America/Indiana/Vincennes
+++ b/library/tzdata/America/Indiana/Vincennes
diff --git a/library/tzdata/America/Indiana/Winamac b/library/tzdata/America/Indiana/Winamac
index fb6cd37..fb6cd37 100644..100755
--- a/library/tzdata/America/Indiana/Winamac
+++ b/library/tzdata/America/Indiana/Winamac
diff --git a/library/tzdata/America/Moncton b/library/tzdata/America/Moncton
index d286c88..d286c88 100644..100755
--- a/library/tzdata/America/Moncton
+++ b/library/tzdata/America/Moncton
diff --git a/library/tzdata/America/North_Dakota/New_Salem b/library/tzdata/America/North_Dakota/New_Salem
index 5a9d229..5a9d229 100644..100755
--- a/library/tzdata/America/North_Dakota/New_Salem
+++ b/library/tzdata/America/North_Dakota/New_Salem
diff --git a/library/tzdata/America/Resolute b/library/tzdata/America/Resolute
index a9881b4..a9881b4 100644..100755
--- a/library/tzdata/America/Resolute
+++ b/library/tzdata/America/Resolute
diff --git a/library/tzdata/Atlantic/Faroe b/library/tzdata/Atlantic/Faroe
index d2c314a..d2c314a 100644..100755
--- a/library/tzdata/Atlantic/Faroe
+++ b/library/tzdata/Atlantic/Faroe
diff --git a/library/tzdata/Australia/Eucla b/library/tzdata/Australia/Eucla
index 8008980..8008980 100644..100755
--- a/library/tzdata/Australia/Eucla
+++ b/library/tzdata/Australia/Eucla
diff --git a/library/tzdata/Europe/Guernsey b/library/tzdata/Europe/Guernsey
index 4372c64..4372c64 100644..100755
--- a/library/tzdata/Europe/Guernsey
+++ b/library/tzdata/Europe/Guernsey
diff --git a/library/tzdata/Europe/Isle_of_Man b/library/tzdata/Europe/Isle_of_Man
index 870ac45..870ac45 100644..100755
--- a/library/tzdata/Europe/Isle_of_Man
+++ b/library/tzdata/Europe/Isle_of_Man
diff --git a/library/tzdata/Europe/Jersey b/library/tzdata/Europe/Jersey
index e4da512..e4da512 100644..100755
--- a/library/tzdata/Europe/Jersey
+++ b/library/tzdata/Europe/Jersey
diff --git a/library/tzdata/Europe/Podgorica b/library/tzdata/Europe/Podgorica
index f4f9066..f4f9066 100644..100755
--- a/library/tzdata/Europe/Podgorica
+++ b/library/tzdata/Europe/Podgorica
diff --git a/library/tzdata/Europe/Volgograd b/library/tzdata/Europe/Volgograd
index 3938683..3938683 100644..100755
--- a/library/tzdata/Europe/Volgograd
+++ b/library/tzdata/Europe/Volgograd
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index 3adc808..f09a441 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -692,24 +692,28 @@ UpdateStringOfOSType(
register Tcl_Obj *objPtr) /* OSType object whose string rep to
* update. */
{
- char string[5];
+ const int size = TCL_UTF_MAX * 4;
+ char *dst = Tcl_InitStringRep(objPtr, NULL, size);
OSType osType = (OSType) objPtr->internalRep.longValue;
- Tcl_DString ds;
- Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
- unsigned len;
-
- string[0] = (char) (osType >> 24);
- string[1] = (char) (osType >> 16);
- string[2] = (char) (osType >> 8);
- string[3] = (char) (osType);
- string[4] = '\0';
- Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
- len = (unsigned) Tcl_DStringLength(&ds) + 1;
- objPtr->bytes = ckalloc(len);
- memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len);
- objPtr->length = Tcl_DStringLength(&ds);
- Tcl_DStringFree(&ds);
+ int written = 0;
+ Tcl_Encoding encoding;
+ char src[5];
+
+ TclOOM(dst, size);
+
+ src[0] = (char) (osType >> 24);
+ src[1] = (char) (osType >> 16);
+ src[2] = (char) (osType >> 8);
+ src[3] = (char) (osType);
+ src[4] = '\0';
+
+ encoding = Tcl_GetEncoding(NULL, "macRoman");
+ Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0,
+ /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL,
+ /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL);
Tcl_FreeEncoding(encoding);
+
+ (void)Tcl_InitStringRep(objPtr, NULL, written);
}
/*
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index 6330de4..6330de4 100644..100755
--- a/tests/lsetComp.test
+++ b/tests/lsetComp.test
diff --git a/tests/notify.test b/tests/notify.test
index d2b9123..d2b9123 100644..100755
--- a/tests/notify.test
+++ b/tests/notify.test
diff --git a/tests/obj.test b/tests/obj.test
index cd33eaa..87c8d08 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -540,7 +540,6 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj {
lappend result [testobj refcount 2]
} {{} 1024 1024 int 4 4 0 int 3 2}
-
test obj-32.1 {freeing very large object trees} {
set x {}
for {set i 0} {$i<100000} {incr i} {
diff --git a/tools/encoding/ebcdic.txt b/tools/encoding/ebcdic.txt
index d9fa42e..d9fa42e 100644..100755
--- a/tools/encoding/ebcdic.txt
+++ b/tools/encoding/ebcdic.txt
diff --git a/tools/encoding/tis-620.txt b/tools/encoding/tis-620.txt
index d3656c5..d3656c5 100644..100755
--- a/tools/encoding/tis-620.txt
+++ b/tools/encoding/tis-620.txt
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 2793d3b..bd54a2e 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -253,9 +253,6 @@ InitializeHostName(
native = u.nodename;
}
}
- if (native == NULL) {
- native = &tclEmptyString;
- }
#else /* !NO_UNAME */
/*
* Uname doesn't exist; try gethostname instead.
@@ -284,9 +281,15 @@ InitializeHostName(
#endif /* NO_UNAME */
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- *lengthPtr = strlen(native);
- *valuePtr = ckalloc(*lengthPtr + 1);
- memcpy(*valuePtr, native, *lengthPtr + 1);
+ if (native) {
+ *lengthPtr = strlen(native);
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, native, *lengthPtr + 1);
+ } else {
+ *lengthPtr = 0;
+ *valuePtr = ckalloc(1);
+ *valuePtr[0] = '\0';
+ }
}
/*
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index cb136be..cb136be 100644..100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 6582ee1..6582ee1 100644..100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c