diff options
-rw-r--r--[-rwxr-xr-x] | compat/zlib/win32/zlib1.dll | bin | 105472 -> 105472 bytes | |||
-rw-r--r--[-rwxr-xr-x] | compat/zlib/win64/zlib1.dll | bin | 116736 -> 116736 bytes | |||
-rw-r--r--[-rwxr-xr-x] | compat/zlib/zlib2ansi | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | doc/GetCwd.3 | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | doc/GetVersion.3 | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | doc/lset.n | 0 | ||||
-rw-r--r-- | generic/tcl.decls | 18 | ||||
-rw-r--r-- | generic/tcl.h | 45 | ||||
-rw-r--r-- | generic/tclAssembly.c | 20 | ||||
-rw-r--r-- | generic/tclBasic.c | 82 | ||||
-rw-r--r-- | generic/tclBinary.c | 182 | ||||
-rw-r--r-- | generic/tclClock.c | 2 | ||||
-rw-r--r-- | generic/tclCmdIL.c | 18 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 13 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 8 | ||||
-rw-r--r-- | generic/tclCompile.c | 32 | ||||
-rw-r--r-- | generic/tclCompile.h | 17 | ||||
-rw-r--r-- | generic/tclDecls.h | 44 | ||||
-rw-r--r-- | generic/tclDictObj.c | 222 | ||||
-rw-r--r-- | generic/tclDisassemble.c | 90 | ||||
-rw-r--r-- | generic/tclEncoding.c | 36 | ||||
-rw-r--r-- | generic/tclEnsemble.c | 40 | ||||
-rw-r--r-- | generic/tclExecute.c | 63 | ||||
-rw-r--r-- | generic/tclIO.c | 43 | ||||
-rw-r--r-- | generic/tclIndexObj.c | 65 | ||||
-rw-r--r-- | generic/tclInt.h | 46 | ||||
-rw-r--r-- | generic/tclInterp.c | 2 | ||||
-rw-r--r-- | generic/tclLink.c | 5 | ||||
-rw-r--r-- | generic/tclListObj.c | 251 | ||||
-rw-r--r-- | generic/tclNamesp.c | 65 | ||||
-rw-r--r-- | generic/tclOOCall.c | 29 | ||||
-rw-r--r-- | generic/tclOOMethod.c | 13 | ||||
-rw-r--r-- | generic/tclObj.c | 420 | ||||
-rw-r--r-- | generic/tclPathObj.c | 251 | ||||
-rw-r--r-- | generic/tclProc.c | 179 | ||||
-rw-r--r-- | generic/tclRegexp.c | 60 | ||||
-rw-r--r-- | generic/tclScan.c | 6 | ||||
-rwxr-xr-x[-rw-r--r--] | generic/tclStrToD.c | 0 | ||||
-rw-r--r-- | generic/tclStringObj.c | 2 | ||||
-rw-r--r-- | generic/tclStubInit.c | 10 | ||||
-rw-r--r-- | generic/tclTest.c | 10 | ||||
-rw-r--r-- | generic/tclTimer.c | 11 | ||||
-rw-r--r-- | generic/tclUtil.c | 30 | ||||
-rw-r--r-- | generic/tclVar.c | 164 | ||||
-rwxr-xr-x[-rw-r--r--] | library/clock.tcl | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/encoding/tis-620.enc | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/af.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/af_za.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ar.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ar_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ar_jo.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ar_lb.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ar_sy.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/be.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/bg.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/bn.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/bn_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ca.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/cs.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/da.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/de.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/de_at.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/de_be.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/el.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_au.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_be.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_bw.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_ca.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_gb.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_hk.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_ie.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_nz.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_ph.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_sg.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_za.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/en_zw.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/eo.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_ar.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_bo.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_cl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_co.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_cr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_do.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_ec.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_gt.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_hn.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_mx.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_ni.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_pa.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_pe.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_pr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_py.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_sv.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_uy.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/es_ve.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/et.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/eu.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/eu_es.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fa.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fa_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fa_ir.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fi.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fo.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fo_fo.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fr_be.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fr_ca.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/fr_ch.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ga.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ga_ie.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/gl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/gl_es.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/gv.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/gv_gb.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/he.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/hi.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/hi_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/hr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/hu.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/id.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/id_id.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/is.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/it.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/it_ch.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ja.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kl_gl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ko.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ko_kr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kok.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kok_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kw.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/kw_gb.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/lt.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/lv.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/mk.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/mr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/mr_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ms.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ms_my.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/mt.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/nb.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/nl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/nl_be.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/nn.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/pl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/pt.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/pt_br.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ro.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ru.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ru_ua.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sh.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sk.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sl.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sq.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sv.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/sw.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ta.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/ta_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/te.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/te_in.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/th.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/tr.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/uk.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/vi.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/zh.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/zh_cn.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/zh_hk.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/zh_sg.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/msgs/zh_tw.msg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Africa/Asmara | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Atikokan | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Blanc-Sablon | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Indiana/Petersburg | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Indiana/Tell_City | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Indiana/Vincennes | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Indiana/Winamac | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Moncton | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/North_Dakota/New_Salem | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/America/Resolute | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Atlantic/Faroe | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Australia/Eucla | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Europe/Guernsey | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Europe/Isle_of_Man | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Europe/Jersey | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Europe/Podgorica | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | library/tzdata/Europe/Volgograd | 0 | ||||
-rw-r--r-- | macosx/tclMacOSXFCmd.c | 36 | ||||
-rwxr-xr-x[-rw-r--r--] | tests/lsetComp.test | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | tests/notify.test | 0 | ||||
-rw-r--r-- | tests/obj.test | 1 | ||||
-rwxr-xr-x[-rw-r--r--] | tools/encoding/ebcdic.txt | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | tools/encoding/tis-620.txt | 0 | ||||
-rw-r--r-- | unix/tclUnixSock.c | 15 | ||||
-rwxr-xr-x[-rw-r--r--] | win/buildall.vc.bat | 0 | ||||
-rwxr-xr-x[-rw-r--r--] | win/tclWinFile.c | 0 |
199 files changed, 1676 insertions, 970 deletions
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll Binary files differindex 3196f4a..3196f4a 100755..100644 --- a/compat/zlib/win32/zlib1.dll +++ b/compat/zlib/win32/zlib1.dll diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll Binary files differindex 81195c3..81195c3 100755..100644 --- a/compat/zlib/win64/zlib1.dll +++ b/compat/zlib/win64/zlib1.dll 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 fa22858..e8578ee 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2394,6 +2394,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) +} # TIP #506 declare 641 { diff --git a/generic/tcl.h b/generic/tcl.h index a77211b..3b6d818 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -618,6 +618,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. @@ -642,27 +665,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 e1d355e..ab48d00 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 */ @@ -845,15 +846,15 @@ CompileAssembleObj( const char* source; /* String representation of the source code */ size_t 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) @@ -867,7 +868,7 @@ CompileAssembleObj( * Not valid, so free it and regenerate. */ - TclFreeIntRep(objPtr); + Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL); } /* @@ -4330,7 +4331,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 a87dca0..ce12770 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -5670,7 +5670,7 @@ TclArgumentGet( * up by the caller. It knows better than us. */ - if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) { + if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) { return; } @@ -6703,9 +6703,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) { @@ -6739,9 +6743,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) { @@ -6875,9 +6883,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) { @@ -6918,10 +6930,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) { @@ -6978,10 +6994,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) { @@ -6989,10 +7009,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) { @@ -7029,14 +7053,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; @@ -7132,7 +7158,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 11a471d..4a03905 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 }; @@ -279,16 +283,15 @@ typedef struct { #define BYTEARRAY_SIZE(len) \ ((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)); } /* @@ -401,11 +404,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); byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); @@ -415,8 +418,9 @@ Tcl_SetByteArrayObj( if ((bytes != NULL) && (length > 0)) { memcpy(byteArrayPtr->bytes, bytes, length); } - objPtr->typePtr = &properByteArrayType; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(&ir, byteArrayPtr); + + Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir); } /* @@ -444,17 +448,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; } /* @@ -485,20 +496,29 @@ Tcl_SetByteArrayLength( size_t length) /* New length for internal byte array. */ { ByteArray *byteArrayPtr; + Tcl_ObjIntRep *irPtr; 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); + byteArrayPtr = GET_BYTEARRAY(irPtr); if (length > byteArrayPtr->allocated) { byteArrayPtr = Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length)); byteArrayPtr->allocated = length; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(irPtr, byteArrayPtr); } TclInvalidateStringRep(objPtr); byteArrayPtr->used = length; @@ -531,12 +551,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; } @@ -546,6 +566,7 @@ SetByteArrayFromAny( byteArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); for (dst = byteArrayPtr->bytes; src < srcEnd; ) { + Tcl_UniChar ch = 0; src += TclUtfToUniChar(src, &ch); improper = improper || (ch > 255); *dst++ = UCHAR(ch); @@ -554,9 +575,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; } @@ -581,8 +602,14 @@ static void FreeByteArrayInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { - Tcl_Free(GET_BYTEARRAY(objPtr)); - objPtr->typePtr = NULL; + Tcl_Free(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &tclByteArrayType))); +} + +static void +FreeProperByteArrayInternalRep( + Tcl_Obj *objPtr) /* Object with internal rep to free. */ +{ + Tcl_Free(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &properByteArrayType))); } /* @@ -609,17 +636,39 @@ DupByteArrayInternalRep( { size_t length; ByteArray *srcArrayPtr, *copyArrayPtr; + Tcl_ObjIntRep ir; - srcArrayPtr = GET_BYTEARRAY(srcPtr); + srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &tclByteArrayType)); length = srcArrayPtr->used; copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); copyArrayPtr->used = length; copyArrayPtr->allocated = length; memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); - SET_BYTEARRAY(copyPtr, copyArrayPtr); - copyPtr->typePtr = srcPtr->typePtr; + 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. */ +{ + size_t length; + ByteArray *srcArrayPtr, *copyArrayPtr; + Tcl_ObjIntRep ir; + + srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &properByteArrayType)); + length = srcArrayPtr->used; + + copyArrayPtr = Tcl_Alloc(BYTEARRAY_SIZE(length)); + copyArrayPtr->used = length; + copyArrayPtr->allocated = length; + memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length); + + SET_BYTEARRAY(&ir, copyArrayPtr); + Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir); } /* @@ -627,9 +676,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. @@ -638,9 +685,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. - * *---------------------------------------------------------------------- */ @@ -649,41 +693,32 @@ UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { - size_t 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; + size_t i, length = byteArrayPtr->used; + size_t size = length; /* * How much space will string rep need? */ - size = length; - for (i = 0; (i < length) && (size != TCL_AUTO_LENGTH); i++) { + for (i = 0; i < length; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size == TCL_AUTO_LENGTH) { - Tcl_Panic("max size for a Tcl value exceeded"); - } - - dst = Tcl_Alloc(size + 1); - objPtr->bytes = dst; - objPtr->length = size; if (size == length) { - memcpy(dst, src, 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); } } @@ -714,6 +749,7 @@ TclAppendBytesToByteArray( { ByteArray *byteArrayPtr; size_t needed; + Tcl_ObjIntRep *irPtr; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); @@ -726,13 +762,21 @@ TclAppendBytesToByteArray( /* Append zero bytes is a no-op. */ return; } - 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); + byteArrayPtr = GET_BYTEARRAY(irPtr); - if (len + byteArrayPtr->used > UINT_MAX) { + if (len > UINT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX); } @@ -752,7 +796,7 @@ TclAppendBytesToByteArray( } if (ptr == NULL) { /* Try to allocate double the increment that is needed (plus). */ - size_t limit = INT_MAX - needed; + size_t limit = UINT_MAX - needed; size_t extra = len + TCL_MIN_GROWTH; size_t growth = (extra > limit) ? limit : extra; @@ -766,7 +810,7 @@ TclAppendBytesToByteArray( } byteArrayPtr = ptr; byteArrayPtr->allocated = attempt; - SET_BYTEARRAY(objPtr, byteArrayPtr); + SET_BYTEARRAY(irPtr, byteArrayPtr); } if (bytes) { @@ -1973,10 +2017,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); @@ -1992,10 +2037,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 9b70e77..57c46dc 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 a261fed..2a7b097 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 16d5bb7..d38fd53 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -1643,9 +1643,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); @@ -1674,8 +1674,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); @@ -1955,7 +1955,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 1dd41f4..057af2b 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 7e10512..2e1ad67 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -707,13 +707,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)) /* *---------------------------------------------------------------------- @@ -956,7 +957,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); } @@ -1286,21 +1290,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; const char *bytes = TclGetString(objPtr); size_t numBytes = objPtr->length; @@ -1314,8 +1320,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++; @@ -1354,7 +1359,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); } @@ -2894,9 +2902,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 a910ed6..6c64cc6 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 8084184..8cf163d 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1742,11 +1742,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); -/* Slot 636 is reserved */ -/* Slot 637 is reserved */ -/* Slot 638 is reserved */ -/* Slot 639 is reserved */ -/* Slot 640 is reserved */ +/* 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); /* 641 */ EXTERN void Tcl_IncrRefCount(Tcl_Obj *objPtr); /* 642 */ @@ -2424,11 +2433,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 (*reserved636)(void); - void (*reserved637)(void); - void (*reserved638)(void); - void (*reserved639)(void); - void (*reserved640)(void); + 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 */ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */ @@ -3688,11 +3697,16 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */ #define TclZipfs_MountBuffer \ (tclStubsPtr->tclZipfs_MountBuffer) /* 635 */ -/* Slot 636 is reserved */ -/* Slot 637 is reserved */ -/* Slot 638 is reserved */ -/* Slot 639 is reserved */ -/* Slot 640 is reserved */ +#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 */ #define Tcl_IncrRefCount \ (tclStubsPtr->tcl_IncrRefCount) /* 641 */ #define Tcl_DecrRefCount \ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 119b7a0..305a678 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 = Tcl_Alloc(sizeof(Dict)); + Dict *oldDict, *newDict = Tcl_Alloc(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; size_t i, length, bytesNeeded = 0; @@ -501,12 +510,17 @@ UpdateStringOfDict( * is not exposed by any API function... */ - size_t numElems = dict->table.numEntries * 2; + size_t 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; } @@ -542,9 +556,8 @@ UpdateStringOfDict( * Pass 2: copy into string rep buffer. */ - dictPtr->length = bytesNeeded - 1; - dictPtr->bytes = Tcl_Alloc(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); @@ -560,7 +573,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) { Tcl_Free(flagPtr); @@ -604,7 +617,7 @@ SetDictFromAny( * the conversion from lists to dictionaries. */ - if (objPtr->typePtr == &tclListType) { + if (Tcl_FetchIntRep(objPtr, &tclListType)) { int objc, i; Tcl_Obj **objv; @@ -660,10 +673,14 @@ SetDictFromAny( TclNewStringObj(keyPtr, elemStart, elemSize); } else { /* Avoid double copy */ + char *dst; + TclNewObj(keyPtr); - keyPtr->bytes = Tcl_Alloc((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), @@ -676,10 +693,14 @@ SetDictFromAny( TclNewStringObj(valuePtr, elemStart, elemSize); } else { /* Avoid double copy */ + char *dst; + TclNewObj(valuePtr); - valuePtr->bytes = Tcl_Alloc((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. */ @@ -701,13 +722,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: @@ -721,6 +739,23 @@ SetDictFromAny( Tcl_Free(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; +} /* *---------------------------------------------------------------------- @@ -765,11 +800,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; } @@ -805,13 +842,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); @@ -819,7 +860,7 @@ TclTraceDictPath( Tcl_IncrRefCount(tmpObj); Tcl_SetHashValue(hPtr, tmpObj); dict->epoch++; - newDict = DICT(tmpObj); + DictGetIntRep(tmpObj, newDict); } newDict->chain = dictPtr; @@ -854,17 +895,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); } @@ -902,16 +950,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); @@ -953,13 +1001,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; @@ -1000,16 +1047,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; @@ -1041,12 +1085,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; } @@ -1093,12 +1136,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; @@ -1272,7 +1314,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) { @@ -1329,7 +1372,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; @@ -1375,9 +1419,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 } @@ -1425,9 +1467,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(); @@ -1613,16 +1653,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]); } @@ -1664,16 +1701,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]); } @@ -1724,8 +1758,7 @@ DictMergeCmd( */ targetObj = objv[1]; - if (targetObj->typePtr != &tclDictType - && SetDictFromAny(interp, targetObj) != TCL_OK) { + if (GetDictFromObj(interp, targetObj) == NULL) { return TCL_ERROR; } @@ -1808,8 +1841,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; } @@ -2016,7 +2048,6 @@ DictInfoCmd( int objc, Tcl_Obj *const *objv) { - Tcl_Obj *dictPtr; Dict *dict; char *statsStr; @@ -2025,12 +2056,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)); @@ -2091,12 +2120,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) { /* @@ -2233,7 +2261,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 f679862..55a1d52 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. */ @@ -795,9 +808,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; } @@ -816,20 +828,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; - if (inst >= LAST_INST_OPCODE) { - sprintf(buf, "inst_%" TCL_Z_MODIFIER "u", inst); - s = buf; + InstNameGetIntRep(objPtr, inst); + + if (inst > LAST_INST_OPCODE) { + dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); + TclOOM(dst, TCL_INTEGER_SPACE + 5); + sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", 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 = Tcl_Alloc(len + 1); - memcpy(objPtr->bytes, s, len + 1); - objPtr->length = len; } /* @@ -941,13 +955,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. */ @@ -1285,6 +1301,7 @@ Tcl_DisassembleObjCmd( Proc *procPtr = NULL; Tcl_HashEntry *hPtr; Object *oPtr; + ByteCode *codePtr; Method *methodPtr; if (objc < 2) { @@ -1303,27 +1320,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; @@ -1373,8 +1382,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]; @@ -1574,7 +1584,7 @@ Tcl_DisassembleObjCmd( "METHODTYPE", NULL); return TCL_ERROR; } - if (procPtr->bodyPtr->typePtr != &tclByteCodeType) { + if (NULL == Tcl_FetchIntRep(procPtr->bodyPtr, &tclByteCodeType)) { Command cmd; /* @@ -1602,7 +1612,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 dfedee5..413f2f2 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 f55eedf..9aa6cbd 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); @@ -2379,8 +2394,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); @@ -2391,10 +2406,8 @@ MakeCachedEnsembleCommand( * our own. */ - TclFreeIntRep(objPtr); ensembleCmd = Tcl_Alloc(sizeof(EnsembleCmdRep)); - objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd; - objPtr->typePtr = &ensembleCmdType; + ECRSetIntRep(objPtr, ensembleCmd); } /* @@ -2799,14 +2812,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); } Tcl_Free(ensembleCmd); - objPtr->typePtr = NULL; } /* @@ -2832,11 +2845,12 @@ DupEnsembleCmdRep( Tcl_Obj *objPtr, Tcl_Obj *copyPtr) { - EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1; + EnsembleCmdRep *ensembleCmd; EnsembleCmdRep *ensembleCopy = Tcl_Alloc(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 d696523..a5fa84c 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -690,20 +690,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); Tcl_Free(searchPtr); - dictPtr = objPtr->internalRep.twoPtrValue.ptr2; + dictPtr = irPtr->twoPtrValue.ptr2; TclDecrRefCount(dictPtr); - - objPtr->typePtr = NULL; } /* @@ -1392,19 +1394,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. */ @@ -1504,7 +1510,9 @@ static void FreeExprCodeInternalRep( Tcl_Obj *objPtr) { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; + ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr); + assert(codePtr != NULL); TclReleaseByteCode(codePtr); } @@ -1542,7 +1550,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 @@ -1560,7 +1569,6 @@ TclCompileObj( * here. */ - codePtr = objPtr->internalRep.twoPtrValue.ptr1; if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != namespacePtr) @@ -1688,7 +1696,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++; @@ -4550,7 +4558,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); @@ -6733,13 +6741,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); @@ -6752,11 +6763,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); @@ -9381,7 +9398,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 30ed68d..621c728 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 *) Tcl_Alloc(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; @@ -11184,11 +11196,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); } /* @@ -11211,9 +11223,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 f16f467..bb48d33 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -202,6 +202,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+1 <= sizeof(char *)) { @@ -211,13 +212,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 @@ -273,17 +277,19 @@ Tcl_GetIndexFromObjStruct( */ if (!(flags & INDEX_TEMP_TABLE)) { - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.twoPtrValue.ptr1; - } else { - TclFreeIntRep(objPtr); - indexRep = Tcl_Alloc(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; @@ -382,16 +388,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 = Tcl_Alloc(len + 1); - memcpy(buf, indexStr, len+1); - objPtr->bytes = buf; - objPtr->length = len; + Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr)); } /* @@ -417,12 +417,14 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1; + Tcl_ObjIntRep ir; IndexRep *dupIndexRep = Tcl_Alloc(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); } /* @@ -446,7 +448,7 @@ static void FreeIndex( Tcl_Obj *objPtr) { - Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1); + Tcl_Free(Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1); objPtr->typePtr = NULL; } @@ -870,10 +872,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); @@ -918,9 +920,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 0d710e2..bfa594d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2300,6 +2300,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 %zu bytes", (size_t)(size)),1))) + +/* * The following enum values are used to specify the runtime platform setting * of the tclPlatform variable. */ @@ -2373,12 +2380,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) @@ -2681,7 +2682,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; @@ -2959,6 +2959,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, void **clientDataPtr, int *typePtr); @@ -4348,7 +4350,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->length = 0; \ } else { \ (objPtr)->bytes = Tcl_Alloc((len) + 1); \ - memcpy((objPtr)->bytes, (bytePtr), (len)); \ + memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ } @@ -4437,6 +4439,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: @@ -4654,18 +4668,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 1bcabe2..4bb2448 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 64b82c1..6227d85 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 8a98fec..d7f9aeb 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 @@ -336,8 +358,7 @@ Tcl_SetListObj( listRepPtr = NewListIntRep(objc, objv, 1); ListSetIntRep(objPtr, listRepPtr); } else { - objPtr->bytes = &tclEmptyString; - objPtr->length = 0; + Tcl_InitStringRep(objPtr, NULL, 0); } } @@ -371,8 +392,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; } @@ -510,10 +533,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; @@ -522,8 +548,8 @@ Tcl_ListObjGetElements( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); *objcPtr = listRepPtr->elemCount; *objvPtr = &listRepPtr->elements; return TCL_OK; @@ -630,10 +656,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; } @@ -641,9 +670,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); @@ -739,7 +768,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 @@ -798,10 +831,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; } @@ -809,9 +844,9 @@ Tcl_ListObjIndex( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); if ((index < 0) || (index >= listRepPtr->elemCount)) { *objPtrPtr = NULL; } else { @@ -852,10 +887,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; } @@ -863,9 +900,9 @@ Tcl_ListObjLength( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); *intPtr = listRepPtr->elemCount; return TCL_OK; } @@ -926,9 +963,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); @@ -939,6 +981,7 @@ Tcl_ListObjReplace( return result; } } + ListGetIntRep(listPtr, listRepPtr); } /* @@ -949,7 +992,6 @@ Tcl_ListObjReplace( * Resist any temptation to optimize this case. */ - listRepPtr = ListRepPtr(listPtr); elemPtrs = &listRepPtr->elements; numElems = listRepPtr->elemCount; @@ -1003,7 +1045,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; @@ -1072,7 +1114,7 @@ Tcl_ListObjReplace( } } - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr; + ListResetIntRep(listPtr, listRepPtr); listRepPtr->refCount++; elemPtrs = &listRepPtr->elements; @@ -1145,10 +1187,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; } @@ -1184,6 +1231,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 @@ -1191,7 +1239,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. @@ -1222,13 +1271,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; } @@ -1352,6 +1400,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. @@ -1359,7 +1408,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. @@ -1448,6 +1498,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 @@ -1583,7 +1634,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); @@ -1597,22 +1649,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) { @@ -1641,8 +1703,8 @@ TclLsetFlat( Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr); } else { TclListObjSetElement(NULL, subListPtr, index, valuePtr); + TclInvalidateStringRep(subListPtr); } - TclInvalidateStringRep(subListPtr); Tcl_IncrRefCount(retValuePtr); return retValuePtr; } @@ -1710,10 +1772,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)); @@ -1726,9 +1791,9 @@ TclListObjSetElement( if (result != TCL_OK) { return result; } + ListGetIntRep(listPtr, listRepPtr); } - listRepPtr = ListRepPtr(listPtr); elemCount = listRepPtr->elemCount; /* @@ -1771,7 +1836,8 @@ TclListObjSetElement( listRepPtr->refCount--; - listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr; + listRepPtr = newPtr; + ListResetIntRep(listPtr, listRepPtr); } elemPtrs = &listRepPtr->elements; @@ -1793,6 +1859,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; } @@ -1805,10 +1883,9 @@ TclListObjSetElement( * a list object. * * Effect - * - * The storage for the internal 'List' pointer of 'listPtr' is freed, the - * 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount' - * of each element of the list is decremented. + * + * Frees listPtr's List* internal representation, if no longer shared. + * May decrement the ref counts of element objects, which may free them. * *---------------------------------------------------------------------- */ @@ -1817,7 +1894,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; @@ -1828,8 +1908,6 @@ FreeListInternalRep( } Tcl_Free(listRepPtr); } - - listPtr->typePtr = NULL; } /* @@ -1852,8 +1930,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); } @@ -1896,7 +1976,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; @@ -1954,11 +2034,13 @@ SetListFromAny( while (nextElem < limit) { const char *elemStart; + char *check; size_t elemSize; int literal; if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem, &elemStart, &nextElem, &elemSize, &literal)) { + fail: while (--elemPtrs >= &listRepPtr->elements) { Tcl_DecrRefCount(*elemPtrs); } @@ -1969,14 +2051,21 @@ SetListFromAny( break; } - /* TODO: replace panic with error on alloc failure? */ - if (literal) { - TclNewStringObj(*elemPtrs, elemStart, elemSize); - } else { - TclNewObj(*elemPtrs); - (*elemPtrs)->bytes = Tcl_Alloc((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. */ @@ -1986,12 +2075,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; } @@ -2021,12 +2109,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 @@ -2041,8 +2134,7 @@ UpdateStringOfList( */ if (numElems == 0) { - listPtr->bytes = &tclEmptyString; - listPtr->length = 0; + Tcl_InitStringRep(listPtr, NULL, 0); return; } @@ -2071,22 +2163,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 = Tcl_Alloc(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) { Tcl_Free(flagPtr); diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 6ec7a00..3933e4c 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; } @@ -4688,8 +4708,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. @@ -4705,7 +4728,6 @@ FreeNsNameInternalRep( TclNsDecrRefCount(resNamePtr->nsPtr); Tcl_Free(resNamePtr); } - objPtr->typePtr = NULL; } /* @@ -4732,11 +4754,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); } /* @@ -4781,24 +4803,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 = Tcl_Alloc(sizeof(ResolvedNsName)); resNamePtr->nsPtr = nsPtr; @@ -4807,10 +4820,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 14f80a4..6a171c0 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 @@ -151,6 +152,7 @@ static const Tcl_ObjType methodNameType = { NULL, NULL }; + /* * ---------------------------------------------------------------------- @@ -245,11 +247,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 @@ -276,21 +279,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); } /* @@ -1188,15 +1186,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 e6785f5..50cd51b 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 f3df304..d69a076 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. @@ -1032,9 +1033,8 @@ TclDbInitNewObj( * debugging. */ { objPtr->refCount = 0; - objPtr->bytes = &tclEmptyString; - objPtr->length = 0; objPtr->typePtr = NULL; + TclInitStringRep(objPtr, NULL, 0); #if TCL_THREADS /* @@ -1692,6 +1692,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 @@ -1718,6 +1803,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_GetBooleanFromObj -- * * Attempt to return a boolean from the Tcl object "objPtr". This @@ -2039,6 +2241,7 @@ Tcl_DbNewDoubleObj( register Tcl_Obj *objPtr; TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep() */ objPtr->bytes = NULL; objPtr->internalRep.doubleValue = dblValue; @@ -2198,15 +2401,12 @@ static void UpdateStringOfDouble( register Tcl_Obj *objPtr) /* Double obj with string rep to update. */ { - char buffer[TCL_DOUBLE_SPACE]; - size_t 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->length = len; - objPtr->bytes = Tcl_Alloc(++len); - memcpy(objPtr->bytes, buffer, len); + Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst); + (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } /* @@ -2314,14 +2514,181 @@ static void UpdateStringOfInt( register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ { - char buffer[TCL_INTEGER_SPACE]; - size_t len; + char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); + + 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) +static void +UpdateStringOfOldInt( + register Tcl_Obj *objPtr) /* Int object whose string rep to update. */ +{ + char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE); + + TclOOM(dst, TCL_INTEGER_SPACE + 1); + (void) Tcl_InitStringRep(objPtr, NULL, + TclFormatInt(dst, objPtr->internalRep.longValue)); +} +#endif + +/* + *---------------------------------------------------------------------- + * + * Tcl_NewLongObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewLongObj to create a new long integer object end up calling the + * debugging function Tcl_DbNewLongObj instead. + * + * Otherwise, if the client is compiled without TCL_MEM_DEBUG defined, + * calls to Tcl_NewLongObj result in a call to one of the two + * Tcl_NewLongObj implementations below. We provide two implementations + * so that the Tcl core can be compiled to do memory debugging of the + * core even if a client does not request it for itself. + * + * Integer and long integer objects share the same "integer" type + * implementation. We store all integers as longs and Tcl_GetIntFromObj + * checks whether the current value of the long can be represented by an + * int. + * + * Results: + * The newly created object is returned. This object will have an invalid + * string representation. The returned object has ref count 0. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_NewLongObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_NewLongObj( + register long longValue) /* Long integer used to initialize the + * new object. */ +{ + return Tcl_DbNewLongObj(longValue, "unknown", 0); +} + +#else /* if not TCL_MEM_DEBUG */ - len = TclFormatInt(buffer, objPtr->internalRep.wideValue); +Tcl_Obj * +Tcl_NewLongObj( + register long longValue) /* Long integer used to initialize the + * new object. */ +{ + register Tcl_Obj *objPtr; - objPtr->length = len; - objPtr->bytes = Tcl_Alloc(len + 1); - memcpy(objPtr->bytes, buffer, (unsigned) len + 1); + TclNewIntObj(objPtr, longValue); + return objPtr; +} +#endif /* if TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_DbNewLongObj -- + * + * If a client is compiled with TCL_MEM_DEBUG defined, calls to + * Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer + * objects end up calling the debugging function Tcl_DbNewLongObj + * instead. We provide two implementations of Tcl_DbNewLongObj so that + * whether the Tcl core is compiled to do memory debugging of the core is + * independent of whether a client requests debugging for itself. + * + * When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj + * calls Tcl_DbCkalloc directly with the file name and line number from + * its caller. This simplifies debugging since then the [memory active] + * command will report the caller's file name and line number when + * reporting objects that haven't been freed. + * + * Otherwise, when the core is compiled without TCL_MEM_DEBUG defined, + * this function just returns the result of calling Tcl_NewLongObj. + * + * Results: + * The newly created long integer object is returned. This object will + * have an invalid string representation. The returned object has ref + * count 0. + * + * Side effects: + * Allocates memory. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_DbNewLongObj +#ifdef TCL_MEM_DEBUG + +Tcl_Obj * +Tcl_DbNewLongObj( + register long longValue, /* Long integer used to initialize the new + * object. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ +{ + register Tcl_Obj *objPtr; + + TclDbNewObj(objPtr, file, line); + /* Optimized TclInvalidateStringRep */ + objPtr->bytes = NULL; + + objPtr->internalRep.wideValue = longValue; + objPtr->typePtr = &tclIntType; + return objPtr; +} + +#else /* if not TCL_MEM_DEBUG */ + +Tcl_Obj * +Tcl_DbNewLongObj( + register long longValue, /* Long integer used to initialize the new + * object. */ + const char *file, /* The name of the source file calling this + * function; used for debugging. */ + int line) /* Line number in the source file; used for + * debugging. */ +{ + return Tcl_NewLongObj(longValue); +} +#endif /* TCL_MEM_DEBUG */ + +/* + *---------------------------------------------------------------------- + * + * Tcl_SetLongObj -- + * + * Modify an object to be an integer object and to have the specified + * long integer value. + * + * Results: + * None. + * + * Side effects: + * The object's old string rep, if any, is freed. Also, any old internal + * rep is freed. + * + *---------------------------------------------------------------------- + */ + +#undef Tcl_SetLongObj +void +Tcl_SetLongObj( + register Tcl_Obj *objPtr, /* Object whose internal rep to init. */ + register long longValue) /* Long integer used to initialize the + * object's value. */ +{ + if (Tcl_IsShared(objPtr)) { + Tcl_Panic("%s called with shared object", "Tcl_SetLongObj"); + } + + TclSetIntObj(objPtr, longValue); } /* @@ -2826,12 +3193,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) { @@ -2846,13 +3211,14 @@ UpdateStringOfBignum( Tcl_Panic("UpdateStringOfBignum: string length limit exceeded"); } - stringVal = Tcl_Alloc(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); } /* @@ -2972,11 +3338,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 c2e7e96..3e65791 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 { * 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 { * 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) { @@ -862,6 +860,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 @@ -875,7 +874,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]; @@ -1152,6 +1151,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 @@ -1162,39 +1163,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. - */ } /* @@ -1326,9 +1304,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 "." @@ -1427,8 +1403,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) { @@ -1495,31 +1472,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 = Tcl_Alloc(sizeof(FsPath)); /* @@ -1528,11 +1486,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; @@ -1541,7 +1495,6 @@ MakePathFromNormalized( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; return TCL_OK; } @@ -1592,25 +1545,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 = Tcl_Alloc(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; @@ -1618,7 +1558,6 @@ Tcl_FSNewNativePath( SETPATHOBJ(pathPtr, fsPathPtr); PATHFLAGS(pathPtr) = 0; - pathPtr->typePtr = &tclFsPathType; return pathPtr; } @@ -1665,20 +1604,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 { /* @@ -1788,9 +1729,7 @@ Tcl_FSGetNormalizedPath( return NULL; } /* TODO: Figure out why this is needed. */ - if (pathPtr->bytes == NULL) { - UpdateStringOfFsPath(pathPtr); - } + TclGetString(pathPtr); (void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen); if (tailLen) { @@ -1842,7 +1781,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 @@ -1860,6 +1799,7 @@ Tcl_FSGetNormalizedPath( /* * That's our reference to copy used. */ + copy = NULL; TclDecrRefCount(dir); TclDecrRefCount(origDir); @@ -1872,7 +1812,7 @@ Tcl_FSGetNormalizedPath( /* * That's our reference to copy used. */ - + copy = NULL; TclDecrRefCount(dir); } PATHFLAGS(pathPtr) = 0; @@ -1884,10 +1824,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; } @@ -1913,7 +1851,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 @@ -1963,7 +1900,6 @@ Tcl_FSGetNormalizedPath( return NULL; } - pureNormalized = 0; Tcl_DecrRefCount(absolutePath); absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath); Tcl_IncrRefCount(absolutePath); @@ -1983,7 +1919,6 @@ Tcl_FSGetNormalizedPath( if (absolutePath == NULL) { return NULL; } - pureNormalized = 0; #endif /* _WIN32 */ } } @@ -1992,35 +1927,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) { - size_t 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 @@ -2166,8 +2078,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; } @@ -2183,10 +2096,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; } @@ -2226,12 +2137,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; } @@ -2330,8 +2242,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; } @@ -2473,27 +2386,21 @@ SetFsPathFromAny( fsPathPtr = Tcl_Alloc(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; } @@ -2516,6 +2423,7 @@ FreeFsPathInternalRep( } if (fsPathPtr->cwdPtr != NULL) { TclDecrRefCount(fsPathPtr->cwdPtr); + fsPathPtr->cwdPtr = NULL; } if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) { Tcl_FSFreeInternalRepProc *freeProc = @@ -2528,7 +2436,6 @@ FreeFsPathInternalRep( } Tcl_Free(fsPathPtr); - pathPtr->typePtr = NULL; } static void @@ -2541,24 +2448,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; @@ -2584,8 +2481,6 @@ DupFsPathInternalRep( } copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr; copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch; - - copyPtr->typePtr = &tclFsPathType; } /* @@ -2617,11 +2512,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); } @@ -2651,6 +2550,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 @@ -2658,7 +2559,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 "". @@ -2673,7 +2574,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 b84a277..8c2309d 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; } @@ -371,7 +406,7 @@ TclCreateProc( { Interp *iPtr = (Interp *) interp; - register Proc *procPtr; + register Proc *procPtr = NULL; int i, result, numArgs; size_t plen; const char *bytes, *argname, *argnamei; @@ -380,7 +415,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 @@ -393,7 +429,6 @@ TclCreateProc( * will be holding a reference to it. */ - procPtr = bodyPtr->internalRep.twoPtrValue.ptr1; procPtr->iPtr = iPtr; procPtr->refCount++; precompiled = 1; @@ -735,6 +770,7 @@ TclObjGetFrame( { register Interp *iPtr = (Interp *) interp; int curLevel, level, result; + const Tcl_ObjIntRep *irPtr; const char *name = NULL; Tcl_WideInt w; @@ -760,8 +796,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); @@ -770,9 +806,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 { @@ -1092,10 +1129,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) { @@ -1258,7 +1295,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; @@ -1268,6 +1305,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 @@ -1335,11 +1374,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 . @@ -1514,7 +1555,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; /* @@ -1526,7 +1568,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) @@ -1724,7 +1765,7 @@ TclNRInterpProcCore( */ procPtr->refCount++; - codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1; + ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr); TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc, NULL, NULL); @@ -1858,7 +1899,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 @@ -1874,7 +1917,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) @@ -1893,11 +1936,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 @@ -2247,10 +2291,7 @@ TclNewProcBodyObj( TclNewObj(objPtr); if (objPtr) { - objPtr->typePtr = &tclProcBodyType; - objPtr->internalRep.twoPtrValue.ptr1 = procPtr; - - procPtr->refCount++; + ProcSetIntRep(objPtr, procPtr); } return objPtr; @@ -2278,11 +2319,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); } /* @@ -2308,7 +2348,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); @@ -2334,15 +2376,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 @@ -2350,14 +2392,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 @@ -2378,7 +2422,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); @@ -2519,21 +2563,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; +} /* *---------------------------------------------------------------------- @@ -2569,7 +2634,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; @@ -2587,24 +2651,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 813dbd3..71f6581 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) + /* *---------------------------------------------------------------------- @@ -579,14 +597,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); @@ -594,21 +607,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; } @@ -755,7 +754,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. @@ -764,7 +767,6 @@ FreeRegexpInternalRep( if (regexpRepPtr->refCount-- <= 1) { FreeRegexp(regexpRepPtr); } - objPtr->typePtr = NULL; } /* @@ -789,11 +791,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 faafabd..65d8144 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 85b3e65..85b3e65 100644..100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 39074d0..d1ada3a 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -4122,7 +4122,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 2a85286..9cbd78d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1327,11 +1327,11 @@ const TclStubs tclStubs = { TclZipfs_Unmount, /* 633 */ TclZipfs_TclLibrary, /* 634 */ TclZipfs_MountBuffer, /* 635 */ - 0, /* 636 */ - 0, /* 637 */ - 0, /* 638 */ - 0, /* 639 */ - 0, /* 640 */ + Tcl_FreeIntRep, /* 636 */ + Tcl_InitStringRep, /* 637 */ + Tcl_FetchIntRep, /* 638 */ + Tcl_StoreIntRep, /* 639 */ + Tcl_HasStringRep, /* 640 */ Tcl_IncrRefCount, /* 641 */ Tcl_DecrRefCount, /* 642 */ Tcl_IsShared, /* 643 */ diff --git a/generic/tclTest.c b/generic/tclTest.c index 615ff48..13e3d6d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7079,17 +7079,11 @@ TestconcatobjCmd( list1Ptr = Tcl_NewStringObj("foo bar sum", -1); Tcl_ListObjLength(NULL, list1Ptr, &len); - if (list1Ptr->bytes != NULL) { - Tcl_Free(list1Ptr->bytes); - list1Ptr->bytes = NULL; - } + Tcl_InvalidateStringRep(list1Ptr); list2Ptr = Tcl_NewStringObj("eeny meeny", -1); Tcl_ListObjLength(NULL, list2Ptr, &len); - if (list2Ptr->bytes != NULL) { - Tcl_Free(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 563be6b..db84005 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 c8adf86..ea2c7a9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1384,9 +1384,9 @@ TclConvertElement( */ if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_AUTO_LENGTH)) { - src = &tclEmptyString; - length = 0; - conversion = CONVERT_BRACE; + p[0] = '{'; + p[1] = '}'; + return 2; } /* @@ -2034,7 +2034,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) { @@ -3634,20 +3634,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. * *---------------------------------------------------------------------- */ @@ -3660,9 +3659,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); @@ -3716,13 +3717,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 37c739f..380b046 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: @@ -5560,12 +5592,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 @@ -5573,17 +5608,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); } /* @@ -5599,14 +5631,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 @@ -5614,17 +5648,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 f33cdf4..ab9b74f 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 = Tcl_Alloc(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 69e83e5..5db07a5 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 = Tcl_Alloc(*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 9545381..9545381 100644..100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c |