S:Y-GL@`qPsOenisBQ]Z`:P)잖l}U-g
SD
؛
0)y7ܽ'wmu+4d7+\. xIXv(vɸU:KQN F"mHi DcYKC
~Z<;,!)8hPTICg$F8דMϒm L{j;v#o w|FSF+uÔ~D3 :1 Қ,e$W5~J40B03[#BN!Xn S ӝmCK fu p'&F
m;F,ml
HDF H+A <*FԴ] ? nώ.xwNJ~ !bQҊl* *y>NWLY.w$"
i6 LZAV*~Hԥ eUg #b H/G'#ކEp@F,0b_ɤ^ihHy k$tec2#0 MD;ޡshݑGXGU
ZmI@dx !0 b.J@dX(6XKd`m˘ah'd;#{҇l"xQDF=EbI @gb %,_cm~zSupZ18V"͘i҂a ttLj44Ё"Bl5_Q{GTYC;nC@,Nk bް],̹ͶE\
L|P?ߡ;(4Dc=m'8U}iIP/Ltu5
XFjɗCeIaeۂٸI1ŭml>p6 kA='Q3Dѡ5L10&' o54a$CRZq}>"$jj hmOSg*Y7UeE6SAA1eV Hߞڬ5`~| oD g1;'ƀ8\jrcF ZFzȆ6"%!D`OZ(Uþs &uF `*9yϋ D+{&s8vG(##po5[9
`r lR2:*8H/ AI- ̹! /NH&!1"Lɕ!7P[:ia"ij NB S"3Xm4Ϙg2묄4j!ohIKfVxoDȶ5 3}Oe<$wP`LBV`R *2L
`0 XEdف*afA H`Ϳ:xSz`t3h! JB&f a(ipzGwf8Q
Kt^c</"Cë3LuךǤyP鏯S?f^oD6E xzyx9z7sZϐ&zrK%cژp|N|`G!cv}bfX탳^_ =ڇuH)>L%ʃW,@ZNT7HT ABm ~^߅(E9Si(j*
D0Ը3Au+'NtHDNUT8Ll677.!Ad(B44aCD>(Z !ET"Okqp7ވ&
aYeY(1 1S7elt7s[~y`Bn Yc T (/rh#WDBDD`xd941HqXaXLAJF= nn" =
i; 1"nT`0Th\Q6c%QEGsXK`@mVűhw~C,OmOMHQ{/vt
8cVg}jS}b68{(+T 3wW/C5ܸYvv HFX# ;4sOl.@vf0GC
= &I* B 5w/#qɬ̆G8'Ku$YByc6p ΨynѩXIB}
Xų卩k9~^t-g?o 4 C f FCoXXAߝ+X,Qג:Y7 ]V( ݠDq?( :=PE-btG/|!O2VFw<D OI@kΫVnKt \Cl!oi CUeEEj>'"9B4.J ԅRS\|k C;EІ !
Cً1ovg9
2eR6i{8VBn pz3ah9--,uDzC#9 RlR'{R%E|Ϛ= }1ݗnk܁5 !áO^6GNAIG"3'h"ɺMqaDݩ}.sۈR4@0vCE#Q!j~"Iw %Q ú*2DɁ Vp9`֙jryGPwskEAL~>L &qϾ U_'H&d%s1ět*i\mDcL !*^Yb1 1߮ǓZj "D3 9fD\>"w .A*` Lr LH/Dt_&U=pypǽ:{̀ y!$@?O mO}~N4
8b?Fpirm_QICD?BĢ 4 ߑOmCthc Xa2=Tc5^KL~%D4R L}ǵdZ-2|Xq
"ۆX~l,+`3BH$$R|"
IH7#u;76. QGhٖÂ`D =y0\bu8vf7ʹcWS 8e7ѽ]
lm[AFN6#jJap1 <2e cc|S릘<;ZH8{8qmIߥ,6s=gK$
\$cnW$;=z4I ڳBY 8 M*=M%
!!f֣b{ MM7Yic+x4q7$n*c@qAjb,l99u++М: p∄gh/ __<fz[!*7lfFccSlPhb
a[¦nlll HThdQ8
T#M$dC ޖt
U
!| N$⨕L ,-J f
f D &97!aAĄ#- n
>'Pu 8 !
%PCKĥ&7*Qݮ;// &i wԶ%fu )K$Ta/z9r-Ȱ78%&ai*?B
X
^ il\Z #.XtZCdh rGޭ.-XGN{qBdEh8O(@MDi
Ȑ`1 XLY?9E]#${r6tSG Gja"~* I-K0ŨKZ$#ʑ
By {6a{ŚbٜY5:D6V(6j3- (2!K%XT븻B 2hLj'2 ` Kc`LH.`JLP0
{bGpXo ">ϩ W, f}/5?i|ɲٱǏ@'DGKG(鷖iJM` P NQ: aنa2a?8*
3"vBº6! QC~^:λDo p)I0E!$Ģt>
/)F&1(rr $lD6t ck B9P@#nƫ(t@A cjRw ӛM
,o+SiIG _g`@5 `
L`B\ffeFAp3iK>y8@2ˤX0d ,A0T9#"ns$O/oZ [dC7tNg%%/6 @l&AH'!@vgU
_,s OoqQ
!Vl\a)C1ʩU*&c\ČI1(
!F8R!2T8F
pvjcqT
kB|4+ p<'@&@ rYaؚ.>@jF &I q!5:-LBRfLҎUGp8N@h$fmZ?ÊP96VzR'"CFO sJ61422'u2R#dR0 2"*K4itSSDq4p#N$""-A'f,"f\cdPMDhj(7Q@acPQ&Pe#*hp[ I6iQV*
*Ah ] "qLqFbn) +N Xk
i9 JfYysaJr^ +JWR:Li*Y"@RJX$(oQǧ
Fsm ,rD\b̥kDLHBA@}D0^)3q!B@s.39څfWY>@N1dJBb@ JW;< i| VL$@r!)Nøz*MT;`9 Q km!9.iU?"%D4]yt
Ye)JeHar=RPjPu%
44
P
()T-Z v N rϕג:xו*Q+1Ǯ7 ݫ!?F /:䭣4J1vѣȷ X?帮?; ?@*E7?"hciyl\.@ P+AH
4 IIQHĭTBE!ABR JP@ @D.HJ4 дR(4 PPA0R0*R)HQH!A$ T JČJR RP#M P#EPU$P%$KE)AM ̉R 04*QK@&BE!H4C.K@@+ai3 :!!ZqsH_ie:s33334IEE$"F)ZAJJLkz`n(!@Nf A@DzB?5Q$5Q_uBt'W&n BQ)iQ *(h
i 5UQT4TQHEC2A@¬DTARL$0E2+I0DLBDD^f
ЁMA!(PACp{^fk&Kia PA0DPEQxa@@ҭ ֘_MG +=Ejo~N7@'g畭k"=Cd_ɦw N1BEHZ ADL͂3
^!+硓C7;u 8!Nm{QBADLj&d
йF=ZO 0@aQA4 m9KnƪNqmO0o{ww9 thSCշhd9ގʩ< ' y U2E@ nz/SdáJ_Ej?BI(A`mz 0yI)\a6E h(zh& **0<==<2=sUI4 O?t S@ߤʥ +MAÁ taL ZM1IDi(ygO8އ^RcM /A!G΅[:/Yc!Cu^Õ "3|4 >xb+3iH
(s]@Q90HPo" L B鈊kDԐHE1c J 0I !4R-
P 40R%1%@@P,@ %Bԙ/d| hɶ50SzHCgC(F 0ԝf B$8I˂ .6q
J*F "$ 0,4IESD"J(K,CTG;%g=^=M DtL iTE8eIR% 7 a䂁d]FL'IoӲf5*T!e z;)(Dpm^@%N8yN! 7| *k!@t: =m e4 f`aV5GiBb.'3@φ^aYs4kXfд5,x'p $ 2 *21|l ҉%Of%fwZ}^YLXfClEtJ˕
qmMif1 fYd`Cll!?4ZbdD![itڮGV*QdPL$hW Q3
4 60lLi2kvKtze:(7x w&-9s8UK0۷
92Yt,#rcBV<7uRo pdW 8-5 g,Rjͬ4WE01fHLi\qWV\eyuq9'cyFhұU,|gqti䣃9$8nݧ3#->7i`R㺧YRO$6f%y K@ l胔Q;;: ז1q}|mi`m^ĆEw"ϣQT|s xK7
6;&F `UYY,%!X i[{BK %JңAJ ђmb*U`&j?JA_A/3DDUUUUUUUDT| Wϳ/E$UOwO'y@^Bpz C*L"{P(~HB
R)
#!(2$F \эC 䛑G u
C9XH-(Q0
H% f9 BPjPh!I1B%P0"`DҘˈ4qyKM D*4 +LNmSIH 8:f?\2 -S<;nxD-'DB.!1<0t(u,C:GA2 4ֲE ,pKDn Ā T3 O|
3SXlN@d @_, ٤Ӳk ZFds.]TفPZ[TeΆ\уq6#}'ARsnqӮt 7&Ldmv&fsd L" Z /7 bY)i>$4#H klMT&(q#h| }
? <4B : N| mǨ'l+릃#?n*~yi(b$JZJ) )di( *(&LCTBQP2@RRP4P(J2!!B5qACT@SĈ!Ja6xKB@EL4$JQS %"HXVQ(g BfJbX$"
HZV&
I'7
: ?=AaQy졵ѣHf@R(o Ln49 $o&H 5;IC++IKTEI!H 4PALٸMp 9 C """"YIh[4!>wǯ\!~p7
j"S㒀L8_{%fQBdDD&104} A--HXOj
Y* Hb
Va"d$1 `"h@%eU $HB31P , i!VZZ()m`J*dF4 RH0'tx#R6AR`R~uͼyzd3-g<a̾z$$=hMJ* vTbaEF][ GͰ ˼JwB\qVu0 HIMDCeL `xCqtHϘAIB,L1J9kk&O4nR -/ߕ!u- $jD(WcX.2
@tG1[\NωXF4axӒ@Z v&np0
C?
1334SF(&+ QLhp%xCArv)[to#\ c" 2U`d~IM2
CGP/O`mO~p H
jp#־b K4Tq91\
|.li6É(ڤXTUTR3*'KAh
^H퐴ǦͥXmj
m 4?uuyxMh^hs'Og-¯3FhȁKAΑ
$4~+Va(d'74t
0"DRZC ?.= @ZJ MNVy` \1I'l* .6,^ˎsH"U,D)̲)Œ9HJ̴aF9a2MB˄Tʘ$!pe@W*U2 cYQ s: gC9O&TAf.-A+(^T,9h;'PܖCMv>IaEd- 3 نa
k3a1_NbɧO,AAIT%Do7D} OR' IJ O,?a@6sNw*TE# R:#QcD q
AD&H {v+H /x@}'k o[;(//c J1Zȷ_"Hl9>Qi7 QyuqӦkm$ r> ]8
ZYJ )&b"*Y
")*N/NXqtT74:r)I3<1J@ ,nDJt@
Á;v`0#1XF |~C8z,pApvht ;;xi1j(1 RUEjcVE@V6BDWS:%M mH*N8li`iVKd(en$W; jd# Cp" bf4њ@,5ewgҘ6quN l1:$LȁCڏCV!r:(xZ{4 l$SbV'2"cZb2 !cӃZ2QB HŨ"Ke@d <!
ƘŅY8eDaFYI8f8%Blj>dRDgL#lo!b{6Y8k-J,_6Me)q dr*c=6Nma ]J6@m,31q@dl;FcglwdH9'z7&0*}:x<IkM9 t+l45Q j . ۃ5Uԇs0fDz !qrH'۰Q9H94Q-0* 9 rJM![x2 $VL AH"\CsQBf`Ȇ1DOrQdL)Pbm8e Z=y=mZl!2hvsngzB ySv k CJqPЦA B( ,6 `AwHʰ NI!pDI::/y lϑ
aA0DP4П`)!|QQS%ztp](Ë`Ft[CU
#QJQMHPm5W20/Jܺn2g<~#jbtf徧B^?4LHݬ̍Y §PF Ȑ2}S ns`'>ĻӬb,' imwo$K ljTBV8&WI6' te,yH4B@is(ٽ^ cH2iWAI9]O-2UO\2͑#*p`Ԁv%L32Ph[ņhHr+.l1 0%PR!H*" <
/ & %6zCPuOTQS_*D
y1FG0="Asl!ڡj{ԭٝО}(Hh!ՅG;r!d2L0Š)P8ܜ22DC҉6B
X>y
|{1BnM40z7H ւ>kM{k:#odTM adu
`Dy"^ ],Atoé
uzB#x@YPqS
2mlb 4
3OM( 0>l u4 5 ' >Nu*q]` $
PA.cP ds~8 g
CL! 1&JmUc#E &# <8R`>o :-RFFyN ,&|p ,c(ăb,H
ydSPB =;$
Jy('3@S8-F!0O +J|+ `V41j(H,z *G2s1 s ' C"*35Mk%`bB& IZ@@&`T%Q$V"ZhJ`h7xF;
2
ǞI
x蛬|OSS"d[9O D 1Fz:ߦm4`=r&0.wa䕢HЩMf1l蠸 衏_FThsK-oR RTKJ4'8
ВC5__͂͝5ϵ D]r'J'nVeC #/x`7edzQFJ ?4:w"8 q$vBe;֘H)TtPs_SBMy* `h迶Aj(7>=W^VL^PH"ZC䣍 $ç=T"NB'P P:sj=d
&~ϋ{"(&[ c;?gG qƴ4idۨrmWu+ piC(b vs,#S9zqZh&--'+`P_)H|Q4}C>T9LA zYͯ^Q8%3#8ÒOX uQ{yȳ &B
X(
#
i(!Y4~w26`^3c=3
J)>˝@?s!BH?a /⢃3cr̓p$l. D_|PvuiSrd\W3! . D IV꯲K1_ĐqҀn/fW fj5h6J,̬<|Ye5@$ ҇Ǣ#?ON
QӘ3bC 9fob@Xqd1}=ZE2/m$X c1# uXV )A㝳3C~ٕ ׯ<&r\!=?P!D]x} Jm▦?ޠ<ѭuQ/ dv
E@UCP$Dƈ N dϥMB|&yW^d:2g B`ܤ Q WnEZ/LP>?uC|e ܷpieC ` fޔ_vӀdF2"2#
kFd4V,QNkFcdc e1VaRm4jFSj0u CkdەB1
*"C&+`O\F
7) 5$Ө3,s1DT\&<V1@h"ExRAjT;ْ B H
ʐh"C@;~ O{
df BtNfG(&o.IBd1%ș= ._A_Fuי7!h{z "Yp q_uhP#=HDA;#n4bʡ&x&Q %'s uh$xO%p`f@lע'r% tk@H{z{헖i l0Vv.8:C!:)'4ą#H nb`P).#3e G 3o~(ryЀLdp+V-Y0i@d !!.J*Q0H J 6 Ng3iAZ
%V!Hh"| sS YK@FFd> ;Aܡ"lJ#G K HHa&uJ
"C.6 :Yhn]B}^3P]& -2_oS
R^^y$f.u8͕*8K }r-6m7D'`Z4Dț#rژ
X˭&\ԉ7$ZZwWWuu9ё4Bco 鶂i$%S}1J%Lb'f+q .( l-y#Rēu;āѾNɫDFC.!:DJ8r4`w)܅@I }S
V&8bceT%%cZ650e5qդ
JSɿ|huy7Mu A@ajҎqk >$!/v!dL"E8$&> #8؛r@J|@m6&aʉ ոP.)rE5*Bf~{349ݙkw]~$ 8r DNc+ ϙ*1 `bXވG Bd%y)"
x%ZGDR&4iPP#c4Fճ>LW eo|RmS\3jep
$LqX{.XRifAkkZK JxiL×l+ 0`;7n5BP* -/H pxfbS M$@nˎf@ARKA w˜ 6Ͱ+h7zhH=c!D4Vf
H81GGYQr7x15h#`{WMt舦/B1TLd}lLcXVH0 e)DR&8jZK
5P!9
?p[TWasG, @$F8hQ/g)p20 WBd(ۃ2T1uX`vƴ8US)., r խ 81$B2(0]Xh#$10I &Mb$J9 Z {L0 0!ȪTyYb/)6 ͕O!s
D]`# 3> g&YB? 4C=Ng{&cAjX)T@eqFOֳ%6 |6ә!b#|3 0 #XK@M2 vm7&Ʀ+Z@,ZFg/$ vpz}k}y0IZeH @@Y@S/"O4FW): hV!b''+>P*kJ~l h@ztк ݱ8S[Nyhzh(/(!/y"L&'~y,5:j;C ^IJL|iZZ v.4[GzP4>
fZthljF45Xj6NER460W*`yjXʆ,hQfTZ-qr J - [ bs8q0llI ,q818qIYPr!paPQiA5MFVu3ɖBJX>MdshLYVDwBF(wHDJrz߭j i:j,P8ya05Zxa¬|hAF fꕴ)7UaӟNR XD4ANauѨ0
k5H i)h*܆"ւD FلYa>Ke
wJL!L J`@xDT #[Cj,anĹ$9Xm$F*b?n>Ca"( D HƜ% XQ"쵅ȷ/dsQI2L@42 -%$ejZ2-{2.a*qyqU&h:,"ӏl^ ؖPp(ycQNfTk zN$n٢Prn%:F(bqdIV!9je7WR
Ӑz1+7Efy*bF$L$`60e Jڂ[~-4 w j=6ѽё}6({Z5zn=tT~!"Rgjd&
af C% -fm+X2 G[oN vcv8 `nMRBvG|]I\L>Pn >7NI:+ }H~e= zPDZzmPL9
JD6*8;[-)֝T6/c;0)
{>Yr(bD \ZtNˌԙ3t(_ޖ(|A |V-2?Ͽx˅[ ALU@P0 Qn623*k0Z0tV=RT7@
[cHL&
-nJ
X-oP}gwb O"Q2Ei4Aʊ(!Q ҪdnQ#VCT5?6+l+""֠.䋌a
4z 7J ሔ4ȇ`0uUGq$_ұAp- ڨأҲB*JH* fĚ4ë sld 4ih !b#dfY: PeI& ܀WXq5p
D0RHpJXX :h A cfahd"CaLdF
K@&A5G wV6AX+1hi ȍ CDeIAIɌ0C,GS86ƉʈƨAE d kjp"TƠgMY3 DQ 44R e 1 #% D H y-W H6[Tol*jlLq * *QNEV(V@0J\H
J B҄KĂo1hD) r5K4ADBJQ (" 2d<93UC(EE#yEUQT ; 0T@ 9,5>O; Q)j;D @* :bd!Y0ڣ^ -^h yH=|s?@KM/e<ǣt4 w/s@Ȫ^Q˸C5Ddd *jQù3lW1ڵ n p㎵9/
2w\-Y/x:2CIb d
zͻP5$"A4w\)m5=D"0>91g2A%`BӡD H P#PTRJP"d-4Gp:iZR `R!X#@F8`$ΏY6vAF
~@ 1۴Q
Wؚ s6ʃ hh>e*J6 -
FhfG흉p
8wfd( :p);w_@od0o[8͘oMBoWiJQdiS@F\%LI!R0$G"RT`3! H jE ᥏ R+u4;Eb =t({YӍ"$Hiƚ]f %'}^5z* Y!
! RDvAbMM q@ d c3zf9(f^){4uA#$ H_NN=0¹IS<@QyNZh ztz+љ
} X< v];CnblWC GC 9_X}l> C,h
-q 'Q:A@1 E@P TR P1vNJ\g>rJ4(>7qת9 TADC$*XvkmD|'Rm[)hdA\0.cDe
j
:6*CBE!iG Q7tddj64Bm
> ׇg3r^u;CR<9 oG
VQi!BBk}iӥvuQ $, +@44
L@4P
*,2HL-r5!:,";U?GCUe]$Uf2b80l]Rd8LCT匵:,4NCLf A, $
mf&Ai"$ 35 aI9a TCUPɓ? 86l)y1&Q4"5hX;u"#1Ï
(0l4n9)l{ J0#mdb̭TAq1fG%Gy9l $%4C4'a
@ QW
tn qROd*j9-#J:}nFR KC%`
}IfDp-*PC]ԣWNDgd*'FF0@{zpv"r 6C2- _l` D>: j`,`=OC
}um>OSS'ˎ0AG[{J
Ǭ[SiGXodˋ,c<.-mcgs.5aSnq0$x ҔP5wp.h'Yèf@mʩU *IX H.M )
aa%'~! H7X*ת0 G|if `NZv
01HD?X(`8g4SD HML}a, #2PZ.?}! 7"0 iM-H
/=94m H
5-aQV tv: c͔J
L̥(v jCA A:|n;LXcB;P3nCw=q<*Hwˡ n6[ 0k%]}*M>$-@;}7#WŲ5=5{N 8:q+87ok>S,4aD
8]x"e{߳XI.h
0;RH@۠ եu])1Mn; 8 td'X .&Z6[/{Zߕ
trb_@4m brяO馧=%KE ]0p$Re
#X ,"
n# @`
8bo67BlO|m}>w*AǮ)Ae#?WǥBVۛM%V}Vʔ 2K@8 ;9 bd"s>p JC` L 2NKnN*bi}1Ij07@inY9eFzo%01;O߰rgnNdM`uW|\1p~rVeA3 30#C,N0 P -yL
PPBpY q ((B.˦!HH@& `MM)JQ1 U0D*̀X
( YHQX%W G }p#"HylpHJ;|$D W $W8cyrxC$b Mn
(3H'o >" @`TW1N0Lĕ= 5PMB;GFWzo0SX䏲Hb*sÃΜ:a !"BJS@1AdP4,ԋB"yH " Q<)Nkދl>%5lDҎ|Wf8H vE0?V{hl"]HMŕ-w:_ VWs A@R0@3 dHPB$("@DC) dw 6C \ȧd(&(@PJb hu$10f:5LК C89 9DA0R1,%$*PM(Ds0B X PJRBHV
VAi )R%iF||vAMRD@)B-
O&@I8qdLAg.t02 0Lj7*NhJ$ $Ld'
j)\)
HՄ ,@ d*ҁP0nC)wa &Q&aQ$dYoǟWHBtwDYqci@*!ܙ0Jtd
f YaXQ[ F<[p!mCJŚDe40P$~FƌaXc::C -6()H JPJL%% @̡Pa%
@
ޮ,e 'h>KFc؋h AGX||r16GP٘HMTA ID RP'08oOoˍ %bJNw<] '1 rT
TK@R +ߟFDN IP%}jQE NJq`k䎅b}p{s[DADTP|Ѹt":s5̷|v5+ズEnr|)a^BK'<7 tY+K4ڢ(13k <}<\ְ
Ja}ct csY MCʵgYj z$OT xqHq½@DD$( (X"B""@< j| *~rx_!/:
b % a6=$zös)+)P3D=%I`\FQSD@qه]5ognrs `Z5DtsV v\) \,Fqp 9h!ȞFIǥ hX!
R.4L@C$w:I0\[û c dV*0w(d鮥!"[Kx^i 3[Q } }u<QD ESa3m[Q@M0'0HCQ"A֭>%^~lZ+c906L@>,B%Z az", ~m4E RDrsE, U #̿(S"YE_
%H ΤM?0wSԇ*]B]Ƚ"^K9#p< JD\HA!tKn
0t :H|ep @KYdAWUposxJwa_GxybrT>rB0:Ȣ^$LO)!$|/9y 1<<-yiů䈃@G"貖> kK:b ?,6aD[B {?]<&dEA(kz@ vJ%"
d :@hG K
~~
%aJnyBߊ`eNRa8®E
Q ى(iNrd9éR]XZ ^\
* appends would cause several memory allocations. As long as
* TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior.
*
* The growth algorithm can be tuned by adjusting the following parameters:
*
* TCL_MIN_GROWTH Additional space, in bytes, to allocate when
* the double allocation has failed. Default is
* 1024 (1 kilobyte). See tclInt.h.
*/
#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#endif
static void
GrowStringBuffer(
Tcl_Obj *objPtr,
int needed,
int flag)
{
/*
* Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->allocated
* flag || objPtr->bytes != NULL
*/
String *stringPtr = GET_STRING(objPtr);
char *ptr = NULL;
int attempt;
if (objPtr->bytes == tclEmptyStringRep) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
attempt = 2 * needed;
if (attempt >= 0) {
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
unsigned int limit = INT_MAX - needed;
unsigned int extra = needed - objPtr->length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
}
if (ptr == NULL) {
/*
* First allocation - just big enough; or last chance fallback.
*/
attempt = needed;
ptr = ckrealloc(objPtr->bytes, attempt + 1);
}
objPtr->bytes = ptr;
stringPtr->allocated = attempt;
}
static void
GrowUnicodeBuffer(
Tcl_Obj *objPtr,
int needed)
{
/*
* Pre-conditions:
* objPtr->typePtr == &tclStringType
* needed > stringPtr->maxChars
* needed < STRING_MAXCHARS
*/
String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
int attempt;
if (stringPtr->maxChars > 0) {
/*
* Subsequent appends - apply the growth algorithm.
*/
attempt = 2 * needed;
if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
/*
* Take care computing the amount of modest growth to avoid
* overflow into invalid argument values for attempt.
*/
unsigned int limit = STRING_MAXCHARS - needed;
unsigned int extra = needed - stringPtr->numChars
+ TCL_MIN_UNICHAR_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
}
if (ptr == NULL) {
/*
* First allocation - just big enough; or last chance fallback.
*/
attempt = needed;
ptr = stringRealloc(stringPtr, attempt);
}
stringPtr = ptr;
stringPtr->maxChars = attempt;
SET_STRING(objPtr, stringPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_NewStringObj --
*
* This function is normally called when not debugging: i.e., when
* TCL_MEM_DEBUG is not defined. It creates a new string object and
* initializes it from the byte pointer and length arguments.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
* of calling the debugging version Tcl_DbNewStringObj.
*
* Results:
* A newly created string object is returned that has ref count zero.
*
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
{
return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
{
Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclNewStringObj(objPtr, bytes, length);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
*
* Tcl_DbNewStringObj --
*
* This function is normally called when debugging: i.e., when
* TCL_MEM_DEBUG is defined. It creates new string objects. It is the
* same as the Tcl_NewStringObj function above except that it 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 correct file name and line number when
* reporting objects that haven't been freed.
*
* When TCL_MEM_DEBUG is not defined, this function just returns the
* result of calling Tcl_NewStringObj.
*
* Results:
* A newly created string object is returned that has ref count zero.
*
* Side effects:
* The new object's internal string representation will be set to a copy
* of the length bytes starting at "bytes". If "length" is negative, use
* bytes up to the first NUL byte; i.e., assume "bytes" points to a
* C-style NUL-terminated string. The object's type is set to NULL. An
* extra NUL is added to the end of the new object's byte array.
*
*----------------------------------------------------------------------
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
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. */
{
Tcl_Obj *objPtr;
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclDbNewObj(objPtr, file, line);
TclInitStringRep(objPtr, bytes, length);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
int length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* negative, use bytes up to the first NUL
* byte. */
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_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */
/*
*---------------------------------------------------------------------------
*
* Tcl_NewUnicodeObj --
*
* This function is creates a new String object and initializes it from
* the given Unicode String. If the Utf String is the same size as the
* Unicode string, don't duplicate the data.
*
* Results:
* The newly created object is returned. This object will have no initial
* string representation. The returned object has a ref count of 0.
*
* Side effects:
* Memory allocated for new object and copy of Unicode argument.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_NewUnicodeObj(
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
int numChars) /* Number of characters in the unicode
* string. */
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
return objPtr;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetCharLength --
*
* Get the length of the Unicode string from the Tcl object.
*
* Results:
* Pointer to unicode string representing the unicode object.
*
* Side effects:
* Frees old internal rep. Allocates memory for new "String" internal
* rep.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
String *stringPtr;
int numChars;
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
* perform the get-length operation.
*/
if (TclIsPureByteArray(objPtr)) {
int length;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
return length;
}
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
/*
* If numChars is unknown, compute it.
*/
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
#if COMPAT
if (numChars < objPtr->length) {
/*
* Since we've just computed the number of chars, and not all UTF
* chars are 1-byte long, go ahead and populate the unicode
* string.
*/
FillUnicodeRep(objPtr);
}
#endif
}
return numChars;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUniChar --
*
* Get the index'th Unicode character from the String object. The index
* is assumed to be in the appropriate range.
*
* Results:
* Returns the index'th Unicode character in the Object.
*
* Side effects:
* Fills unichar with the index'th Unicode character.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
int index) /* Get the index'th Unicode character. */
{
String *stringPtr;
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
* perform the indexing operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
return (Tcl_UniChar) bytes[index];
}
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (Tcl_UniChar) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
return stringPtr->unicode[index];
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUnicode --
*
* Get the Unicode form of the String object. If the object is not
* already a String object, it will be converted to one. If the String
* object does not have a Unicode rep, then one is create from the UTF
* string format.
*
* Results:
* Returns a pointer to the object's internal Unicode string.
*
* Side effects:
* Converts the object to have the String internal rep.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar *
Tcl_GetUnicode(
Tcl_Obj *objPtr) /* The object to find the unicode string
* for. */
{
return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetUnicodeFromObj --
*
* Get the Unicode form of the String object with length. If the object
* is not already a String object, it will be converted to one. If the
* String object does not have a Unicode rep, then one is create from the
* UTF string format.
*
* Results:
* Returns a pointer to the object's internal Unicode string.
*
* Side effects:
* Converts the object to have the String internal rep.
*
*----------------------------------------------------------------------
*/
Tcl_UniChar *
Tcl_GetUnicodeFromObj(
Tcl_Obj *objPtr, /* The object to find the unicode string
* for. */
int *lengthPtr) /* If non-NULL, the location where the string
* rep's unichar length should be stored. If
* NULL, no length is stored. */
{
String *stringPtr;
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
*lengthPtr = stringPtr->numChars;
}
return stringPtr->unicode;
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetRange --
*
* Create a Tcl Object that contains the chars between first and last of
* the object indicated by "objPtr". If the object is not already a
* String object, convert it to one. The first and last indices are
* assumed to be in the appropriate range.
*
* Results:
* Returns a new Tcl Object of the String type.
*
* Side effects:
* Changes the internal rep of "objPtr" to the String type.
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
int first, /* First index of the range. */
int last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
/*
* Optimize the case where we're really dealing with a bytearray object
* without string representation; we don't need to convert to a string to
* perform the substring operation.
*/
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
return Tcl_NewByteArrayObj(bytes+first, last-first+1);
}
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (stringPtr->numChars == -1) {
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
/*
* Since we know the char length of the result, store it.
*/
SetStringFromAny(NULL, newObjPtr);
stringPtr = GET_STRING(newObjPtr);
stringPtr->numChars = newObjPtr->length;
return newObjPtr;
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetStringObj --
*
* Modify an object to hold a string that is a copy of the bytes
* indicated by the byte pointer and length arguments.
*
* Results:
* None.
*
* Side effects:
* The object's string representation will be set to a copy of the
* "length" bytes starting at "bytes". If "length" is negative, use bytes
* up to the first NUL byte; i.e., assume "bytes" points to a C-style
* NUL-terminated string. The object's old string and internal
* representations are freed and the object's type is set NULL.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetStringObj(
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
int length) /* The number of bytes to copy from "bytes"
* when initializing the object. If negative,
* use bytes up to the first NUL byte.*/
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
* Set the type to NULL and free any internal rep for the old type.
*/
TclFreeIntRep(objPtr);
/*
* Free any old string rep, then set the string rep to a copy of the
* length bytes starting at "bytes".
*/
TclInvalidateStringRep(objPtr);
if (length < 0) {
length = (bytes? strlen(bytes) : 0);
}
TclInitStringRep(objPtr, bytes, length);
}
/*
*----------------------------------------------------------------------
*
* Tcl_SetObjLength --
*
* This function changes the length of the string representation of an
* object.
*
* Results:
* None.
*
* Side effects:
* If the size of objPtr's string representation is greater than length,
* then it is reduced to length and a new terminating null byte is stored
* in the strength. If the length of the string representation is greater
* than length, the storage space is reallocated to the given length; a
* null byte is stored at the end, but other bytes past the end of the
* original string representation are undefined. The object's internal
* representation is changed to "expendable string".
*
*----------------------------------------------------------------------
*/
void
Tcl_SetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (length < 0) {
/*
* Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
Tcl_Panic("Tcl_SetObjLength: negative length requested: "
"%d (integer overflow?)", length);
}
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
}
if (objPtr->bytes && objPtr->length == length) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
if (length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
if (objPtr->bytes == tclEmptyStringRep) {
objPtr->bytes = ckalloc(length + 1);
} else {
objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
}
stringPtr->allocated = length;
}
objPtr->length = length;
objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
stringCheckLimits(length);
if (length > stringPtr->maxChars) {
stringPtr = stringRealloc(stringPtr, length);
SET_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
/*
* Mark the new end of the unicode string
*/
stringPtr->numChars = length;
stringPtr->unicode[length] = 0;
stringPtr->hasUnicode = 1;
/*
* Can only get here when objPtr->bytes == NULL. No need to invalidate
* the string rep.
*/
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AttemptSetObjLength --
*
* This function changes the length of the string representation of an
* object. It uses the attempt* (non-panic'ing) memory allocators.
*
* Results:
* 1 if the requested memory was allocated, 0 otherwise.
*
* Side effects:
* If the size of objPtr's string representation is greater than length,
* then it is reduced to length and a new terminating null byte is stored
* in the strength. If the length of the string representation is greater
* than length, the storage space is reallocated to the given length; a
* null byte is stored at the end, but other bytes past the end of the
* original string representation are undefined. The object's internal
* representation is changed to "expendable string".
*
*----------------------------------------------------------------------
*/
int
Tcl_AttemptSetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
int length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (length < 0) {
/*
* Setting to a negative length is nonsense. This is probably the
* result of overflowing the signed integer range.
*/
return 0;
}
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
}
if (objPtr->bytes && objPtr->length == length) {
return 1;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (objPtr->bytes != NULL) {
/*
* Change length of an existing string rep.
*/
if (length > stringPtr->allocated) {
/*
* Need to enlarge the buffer.
*/
char *newBytes;
if (objPtr->bytes == tclEmptyStringRep) {
newBytes = attemptckalloc(length + 1);
} else {
newBytes = attemptckrealloc(objPtr->bytes, length + 1);
}
if (newBytes == NULL) {
return 0;
}
objPtr->bytes = newBytes;
stringPtr->allocated = length;
}
objPtr->length = length;
objPtr->bytes[length] = 0;
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
} else {
/*
* Changing length of pure unicode string.
*/
if (length > STRING_MAXCHARS) {
return 0;
}
if (length > stringPtr->maxChars) {
stringPtr = stringAttemptRealloc(stringPtr, length);
if (stringPtr == NULL) {
return 0;
}
SET_STRING(objPtr, stringPtr);
stringPtr->maxChars = length;
}
/*
* Mark the new end of the unicode string.
*/
stringPtr->unicode[length] = 0;
stringPtr->numChars = length;
stringPtr->hasUnicode = 1;
/*
* Can only get here when objPtr->bytes == NULL. No need to invalidate
* the string rep.
*/
}
return 1;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_SetUnicodeObj --
*
* Modify an object to hold the Unicode string indicated by "unicode".
*
* Results:
* None.
*
* Side effects:
* Memory allocated for new "String" internal rep.
*
*---------------------------------------------------------------------------
*/
void
Tcl_SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeIntRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
static int
UnicodeLength(
const Tcl_UniChar *unicode)
{
int numChars = 0;
if (unicode) {
while (numChars >= 0 && unicode[numChars] != 0) {
numChars++;
}
}
stringCheckLimits(numChars);
return numChars;
}
static void
SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
int numChars) /* Number of characters in the unicode
* string. */
{
String *stringPtr;
if (numChars < 0) {
numChars = UnicodeLength(unicode);
}
/*
* Allocate enough space for the String structure + Unicode string.
*/
stringCheckLimits(numChars);
stringPtr = stringAlloc(numChars);
SET_STRING(objPtr, stringPtr);
objPtr->typePtr = &tclStringType;
stringPtr->maxChars = numChars;
memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
stringPtr->hasUnicode = 1;
TclInvalidateStringRep(objPtr);
stringPtr->allocated = 0;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendLimitedToObj --
*
* This function appends a limited number of bytes from a sequence of
* bytes to an object, marking any limitation with an ellipsis.
*
* Results:
* None.
*
* Side effects:
* The bytes at *bytes are appended to the string representation of
* objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendLimitedToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
int length, /* The number of bytes available to be
* appended from "bytes". If < 0, then all
* bytes up to a NUL byte are available. */
int limit, /* The maximum number of bytes to append to
* the object. */
const char *ellipsis) /* Ellipsis marker string, appended to the
* object to indicate not all available bytes
* at "bytes" were appended. */
{
String *stringPtr;
int toCopy = 0;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
}
if (length < 0) {
length = (bytes ? strlen(bytes) : 0);
}
if (length == 0) {
return;
}
if (length <= limit) {
toCopy = length;
} else {
if (ellipsis == NULL) {
ellipsis = "...";
}
toCopy = (bytes == NULL) ? limit
: Tcl_UtfPrev(bytes+limit+1-strlen(ellipsis), bytes) - bytes;
}
/*
* If objPtr has a valid Unicode rep, then append the Unicode conversion
* of "bytes" to the objPtr's Unicode rep, otherwise append "bytes" to
* objPtr's string rep.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
} else {
AppendUtfToUtfRep(objPtr, bytes, toCopy);
}
if (length <= limit) {
return;
}
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
AppendUtfToUnicodeRep(objPtr, ellipsis, strlen(ellipsis));
} else {
AppendUtfToUtfRep(objPtr, ellipsis, strlen(ellipsis));
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendToObj --
*
* This function appends a sequence of bytes to an object.
*
* Results:
* None.
*
* Side effects:
* The bytes at *bytes are appended to the string representation of
* objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
int length) /* The number of bytes to append from "bytes".
* If < 0, then append all bytes up to NUL
* byte. */
{
Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendUnicodeToObj --
*
* This function appends a Unicode string to an object in the most
* efficient manner possible. Length must be >= 0.
*
* Results:
* None.
*
* Side effects:
* Invalidates the string rep and creates a new Unicode string.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendUnicodeToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
int length) /* Number of chars in "unicode". */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
}
if (length == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then append the "unicode" to the
* objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
* objPtr's string rep.
*/
if (stringPtr->hasUnicode
#if COMPAT
&& stringPtr->numChars > 0
#endif
) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendObjToObj --
*
* This function appends the string rep of one object to another.
* "objPtr" cannot be a shared object.
*
* Results:
* None.
*
* Side effects:
* The string rep of appendObjPtr is appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
int length, numChars, appendNumChars = -1;
const char *bytes;
/*
* Special case: second object is standard-empty is fast case. We know
* that appending nothing to anything leaves that starting anything...
*/
if (appendObjPtr->bytes == tclEmptyStringRep) {
return;
}
/*
* Handle append of one bytearray object to another as a special case.
* Note that we only do this when the objects don't have string reps; if
* it did, then appending the byte arrays together could well lose
* information; this is a special-case optimization only.
*/
if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
&& TclIsPureByteArray(appendObjPtr)) {
/*
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
* and essentially all of the time that would be fine. However,
* it would run into trouble in the case where objPtr and
* appendObjPtr point to the same thing. That may never be a
* good idea. It seems to violate Copy On Write, and we don't
* have any tests for the situation, since making any Tcl commands
* that call Tcl_AppendObjToObj() do that appears impossible
* (They honor Copy On Write!). For the sake of extensions that
* go off into that realm, though, here's a more complex approach
* that can handle all the cases.
*/
/* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
/* Grow buffer enough for the append */
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
/* Reset objPtr back to the original value */
Tcl_SetByteArrayLength(objPtr, length);
/*
* Now do the append knowing that buffer growth cannot cause
* any trouble.
*/
TclAppendBytesToByteArray(objPtr,
Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
return;
}
/*
* Must append as strings.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If objPtr has a valid Unicode rep, then get a Unicode string from
* appendObjPtr and append it.
*/
if (stringPtr->hasUnicode
#if COMPAT
&& stringPtr->numChars > 0
#endif
) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
if (appendObjPtr->typePtr == &tclStringType) {
Tcl_UniChar *unicode =
Tcl_GetUnicodeFromObj(appendObjPtr, &numChars);
AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
} else {
bytes = TclGetStringFromObj(appendObjPtr, &length);
AppendUtfToUnicodeRep(objPtr, bytes, length);
}
return;
}
/*
* Append to objPtr's UTF string rep. If we know the number of characters
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = TclGetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
AppendUtfToUtfRep(objPtr, bytes, length);
if (numChars >= 0 && appendNumChars >= 0
#if COMPAT
&& appendNumChars == length
#endif
) {
stringPtr->numChars = numChars + appendNumChars;
}
}
/*
*----------------------------------------------------------------------
*
* AppendUnicodeToUnicodeRep --
*
* This function appends the contents of "unicode" to the Unicode rep of
* "objPtr". objPtr must already have a valid Unicode rep.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
int appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
int numChars;
if (appendNumChars < 0) {
appendNumChars = UnicodeLength(unicode);
}
if (appendNumChars == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
/*
* If not enough space has been allocated for the unicode rep, reallocate
* the internal rep object with additional space. First try to double the
* required allocation; if that fails, try a more modest increase. See the
* "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
* explanation of this growth algorithm.
*/
numChars = stringPtr->numChars + appendNumChars;
stringCheckLimits(numChars);
if (numChars > stringPtr->maxChars) {
int offset = -1;
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations due to
* the reallocs below.
*/
if (unicode && unicode >= stringPtr->unicode
&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
offset = unicode - stringPtr->unicode;
}
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
/*
* Relocate unicode if needed; see above.
*/
if (offset >= 0) {
unicode = stringPtr->unicode + offset;
}
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
if (unicode) {
memmove(stringPtr->unicode + stringPtr->numChars, unicode,
appendNumChars * sizeof(Tcl_UniChar));
}
stringPtr->unicode[numChars] = 0;
stringPtr->numChars = numChars;
stringPtr->allocated = 0;
TclInvalidateStringRep(objPtr);
}
/*
*----------------------------------------------------------------------
*
* AppendUnicodeToUtfRep --
*
* This function converts the contents of "unicode" to UTF and appends
* the UTF to the string rep of "objPtr".
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUnicodeToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to convert to UTF. */
int numChars) /* Number of chars of "unicode" to convert. */
{
String *stringPtr = GET_STRING(objPtr);
numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
if (stringPtr->numChars != -1) {
stringPtr->numChars += numChars;
}
#if COMPAT
/*
* Invalidate the unicode rep.
*/
stringPtr->hasUnicode = 0;
#endif
}
/*
*----------------------------------------------------------------------
*
* AppendUtfToUnicodeRep --
*
* This function converts the contents of "bytes" to Unicode and appends
* the Unicode to the Unicode rep of "objPtr". objPtr must already have a
* valid Unicode rep. numBytes must be non-negative.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUtfToUnicodeRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to convert to Unicode. */
int numBytes) /* Number of bytes of "bytes" to convert. */
{
String *stringPtr;
if (numBytes == 0) {
return;
}
ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
TclInvalidateStringRep(objPtr);
stringPtr = GET_STRING(objPtr);
stringPtr->allocated = 0;
}
/*
*----------------------------------------------------------------------
*
* AppendUtfToUtfRep --
*
* This function appends "numBytes" bytes of "bytes" to the UTF string
* rep of "objPtr". objPtr must already have a valid String rep.
* numBytes must be non-negative.
*
* Results:
* None.
*
* Side effects:
* objPtr's internal rep is reallocated.
*
*----------------------------------------------------------------------
*/
static void
AppendUtfToUtfRep(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* String to append. */
int numBytes) /* Number of bytes of "bytes" to append. */
{
String *stringPtr;
int newLength, oldLength;
if (numBytes == 0) {
return;
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
*/
if (objPtr->bytes == NULL) {
objPtr->length = 0;
}
oldLength = objPtr->length;
newLength = numBytes + oldLength;
if (newLength < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
stringPtr = GET_STRING(objPtr);
if (newLength > stringPtr->allocated) {
int offset = -1;
/*
* Protect against case where unicode points into the existing
* stringPtr->unicode array. Force it to follow any relocations due to
* the reallocs below.
*/
if (bytes && bytes >= objPtr->bytes
&& bytes <= objPtr->bytes + objPtr->length) {
offset = bytes - objPtr->bytes;
}
/*
* TODO: consider passing flag=1: no overalloc on first append. This
* would make test stringObj-8.1 fail.
*/
GrowStringBuffer(objPtr, newLength, 0);
/*
* Relocate bytes if needed; see above.
*/
if (offset >= 0) {
bytes = objPtr->bytes + offset;
}
}
/*
* Invalidate the unicode data.
*/
stringPtr->numChars = -1;
stringPtr->hasUnicode = 0;
if (bytes) {
memmove(objPtr->bytes + oldLength, bytes, numBytes);
}
objPtr->bytes[newLength] = 0;
objPtr->length = newLength;
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendStringsToObjVA --
*
* This function appends one or more null-terminated strings to an
* object.
*
* Results:
* None.
*
* Side effects:
* The contents of all the string arguments are appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendStringsToObjVA(
Tcl_Obj *objPtr, /* Points to the object to append to. */
va_list argList) /* Variable argument list. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
}
while (1) {
const char *bytes = va_arg(argList, char *);
if (bytes == NULL) {
break;
}
Tcl_AppendToObj(objPtr, bytes, -1);
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendStringsToObj --
*
* This function appends one or more null-terminated strings to an
* object.
*
* Results:
* None.
*
* Side effects:
* The contents of all the string arguments are appended to the string
* representation of objPtr.
*
*----------------------------------------------------------------------
*/
void
Tcl_AppendStringsToObj(
Tcl_Obj *objPtr,
...)
{
va_list argList;
va_start(argList, objPtr);
Tcl_AppendStringsToObjVA(objPtr, argList);
va_end(argList);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendFormatToObj --
*
* This function appends a list of Tcl_Obj's to a Tcl_Obj according to
* the formatting instructions embedded in the format string. The
* formatting instructions are inspired by sprintf(). Returns TCL_OK when
* successful. If there's an error in the arguments, TCL_ERROR is
* returned, and an error message is written to the interp, if non-NULL.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Tcl_AppendFormatToObj(
Tcl_Interp *interp,
Tcl_Obj *appendObj,
const char *format,
int objc,
Tcl_Obj *const objv[])
{
const char *span = format, *msg, *errCode;
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
int originalLength, limit;
static const char *mixedXPG =
"cannot mix \"%\" and \"%n$\" conversion specifiers";
static const char *const badIndex[2] = {
"not enough arguments for all format specifiers",
"\"%n$\" argument index out of range"
};
static const char *overflow = "max size for a Tcl value exceeded";
if (Tcl_IsShared(appendObj)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
}
TclGetStringFromObj(appendObj, &originalLength);
limit = INT_MAX - originalLength;
/*
* Format string is NUL-terminated.
*/
while (*format != '\0') {
char *end;
int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
int width, gotPrecision, precision, useShort, useWide, useBig;
int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
Tcl_Obj *segment;
Tcl_UniChar ch;
int step = Tcl_UtfToUniChar(format, &ch);
format += step;
if (ch != '%') {
numBytes += step;
continue;
}
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
limit -= numBytes;
numBytes = 0;
}
/*
* Saw a % : process the format specifier.
*
* Step 0. Handle special case of escaped format marker (i.e., %%).
*/
step = Tcl_UtfToUniChar(format, &ch);
if (ch == '%') {
span = format;
numBytes = step;
format += step;
continue;
}
/*
* Step 1. XPG3 position specifier
*/
newXpg = 0;
if (isdigit(UCHAR(ch))) {
int position = strtoul(format, &end, 10);
if (*end == '$') {
newXpg = 1;
objIndex = position - 1;
format = end + 1;
step = Tcl_UtfToUniChar(format, &ch);
}
}
if (newXpg) {
if (gotSequential) {
msg = mixedXPG;
errCode = "MIXEDSPECTYPES";
goto errorMsg;
}
gotXpg = 1;
} else {
if (gotXpg) {
msg = mixedXPG;
errCode = "MIXEDSPECTYPES";
goto errorMsg;
}
gotSequential = 1;
}
if ((objIndex < 0) || (objIndex >= objc)) {
msg = badIndex[gotXpg];
errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
/*
* Step 2. Set of flags.
*/
gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
sawFlag = 1;
do {
switch (ch) {
case '-':
gotMinus = 1;
break;
case '#':
gotHash = 1;
break;
case '0':
gotZero = 1;
break;
case ' ':
gotSpace = 1;
break;
case '+':
gotPlus = 1;
break;
default:
sawFlag = 0;
}
if (sawFlag) {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
} while (sawFlag);
/*
* Step 3. Minimum field width.
*/
width = 0;
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
goto error;
}
if (width < 0) {
width = -width;
gotMinus = 1;
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
if (width > limit) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
/*
* Step 4. Precision.
*/
gotPrecision = precision = 0;
if (ch == '.') {
gotPrecision = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
if (isdigit(UCHAR(ch))) {
precision = strtoul(format, &end, 10);
format = end;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == '*') {
if (objIndex >= objc - 1) {
msg = badIndex[gotXpg];
errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
goto errorMsg;
}
if (TclGetIntFromObj(interp, objv[objIndex], &precision)
!= TCL_OK) {
goto error;
}
/*
* TODO: Check this truncation logic.
*/
if (precision < 0) {
precision = 0;
}
objIndex++;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
}
/*
* Step 5. Length modifier.
*/
useShort = useWide = useBig = 0;
if (ch == 'h') {
useShort = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
} else if (ch == 'l') {
format += step;
step = Tcl_UtfToUniChar(format, &ch);
if (ch == 'l') {
useBig = 1;
format += step;
step = Tcl_UtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
} else {
useWide = 1;
#endif
}
}
format += step;
span = format;
/*
* Step 6. The actual conversion character.
*/
segment = objv[objIndex];
numChars = -1;
if (ch == 'i') {
ch = 'd';
}
switch (ch) {
case '\0':
msg = "format string ended in middle of field specifier";
errCode = "INCOMPLETE";
goto errorMsg;
case 's':
if (gotPrecision) {
numChars = Tcl_GetCharLength(segment);
if (precision < numChars) {
segment = Tcl_GetRange(segment, 0, precision - 1);
numChars = precision;
Tcl_IncrRefCount(segment);
allocSegment = 1;
}
}
break;
case 'c': {
char buf[TCL_UTF_MAX];
int code, length;
if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
break;
}
case 'u':
if (useBig) {
msg = "unsigned bignum format is invalid";
errCode = "BADUNSIGNED";
goto errorMsg;
}
case 'd':
case 'o':
case 'x':
case 'X':
case 'b': {
short s = 0; /* Silence compiler warning; only defined and
* used when useShort is true. */
long l;
Tcl_WideInt w;
mp_int big;
int toAppend, isNegative = 0;
if (useBig) {
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
Tcl_GetWideIntFromObj(NULL, objPtr, &w);
Tcl_DecrRefCount(objPtr);
}
isNegative = (w < (Tcl_WideInt) 0);
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
Tcl_Obj *objPtr;
if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
goto error;
}
mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
objPtr = Tcl_NewBignumObj(&big);
Tcl_IncrRefCount(objPtr);
TclGetLongFromObj(NULL, objPtr, &l);
Tcl_DecrRefCount(objPtr);
} else {
l = Tcl_WideAsLong(w);
}
if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
} else {
isNegative = (l < (long) 0);
}
} else if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
} else {
isNegative = (l < (long) 0);
}
segment = Tcl_NewObj();
allocSegment = 1;
segmentLimit = INT_MAX;
Tcl_IncrRefCount(segment);
if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
Tcl_AppendToObj(segment,
(isNegative ? "-" : gotPlus ? "+" : " "), 1);
segmentLimit -= 1;
}
if (gotHash) {
switch (ch) {
case 'o':
Tcl_AppendToObj(segment, "0", 1);
segmentLimit -= 1;
precision--;
break;
case 'x':
case 'X':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
case 'b':
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
}
}
switch (ch) {
case 'd': {
int length;
Tcl_Obj *pure;
const char *bytes;
if (useShort) {
pure = Tcl_NewIntObj((int) s);
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
} else if (useBig) {
pure = Tcl_NewBignumObj(&big);
} else {
pure = Tcl_NewLongObj(l);
}
Tcl_IncrRefCount(pure);
bytes = TclGetStringFromObj(pure, &length);
/*
* Already did the sign above.
*/
if (*bytes == '-') {
length--;
bytes++;
}
toAppend = length;
/*
* Canonical decimal string reps for integers are composed
* entirely of one-byte encoded characters, so "length" is the
* number of chars.
*/
if (gotPrecision) {
if (length < precision) {
segmentLimit -= precision - length;
}
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
gotZero = 0;
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
if (length < width) {
segmentLimit -= width - length;
}
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
if (toAppend > segmentLimit) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(segment, bytes, toAppend);
Tcl_DecrRefCount(pure);
break;
}
case 'u':
case 'o':
case 'x':
case 'X':
case 'b': {
Tcl_WideUInt bits = (Tcl_WideUInt) 0;
Tcl_WideInt numDigits = (Tcl_WideInt) 0;
int length, numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Obj *pure;
char *bytes;
if (ch == 'u') {
base = 10;
} else if (ch == 'o') {
base = 8;
numBits = 3;
} else if (ch == 'b') {
base = 2;
numBits = 1;
}
if (useShort) {
unsigned short us = (unsigned short) s;
bits = (Tcl_WideUInt) us;
while (us) {
numDigits++;
us /= base;
}
} else if (useWide) {
Tcl_WideUInt uw = (Tcl_WideUInt) w;
bits = uw;
while (uw) {
numDigits++;
uw /= base;
}
} else if (useBig && big.used) {
int leftover = (big.used * DIGIT_BIT) % numBits;
mp_digit mask = (~(mp_digit)0) << (DIGIT_BIT-leftover);
numDigits = 1 +
(((Tcl_WideInt) big.used * DIGIT_BIT) / numBits);
while ((mask & big.dp[big.used-1]) == 0) {
numDigits--;
mask >>= numBits;
}
if (numDigits > INT_MAX) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
} else if (!useBig) {
unsigned long ul = (unsigned long) l;
bits = (Tcl_WideUInt) ul;
while (ul) {
numDigits++;
ul /= base;
}
}
/*
* Need to be sure zero becomes "0", not "".
*/
if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
numDigits = 1;
}
pure = Tcl_NewObj();
Tcl_SetObjLength(pure, (int) numDigits);
bytes = TclGetString(pure);
toAppend = length = (int) numDigits;
while (numDigits--) {
int digitOffset;
if (useBig && big.used) {
if (index < big.used && (size_t) shift <
CHAR_BIT*sizeof(Tcl_WideUInt) - DIGIT_BIT) {
bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
shift += DIGIT_BIT;
}
shift -= numBits;
}
digitOffset = (int) (bits % base);
if (digitOffset > 9) {
bytes[numDigits] = 'a' + digitOffset - 10;
} else {
bytes[numDigits] = '0' + digitOffset;
}
bits /= base;
}
if (useBig) {
mp_clear(&big);
}
if (gotPrecision) {
if (length < precision) {
segmentLimit -= precision - length;
}
while (length < precision) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
gotZero = 0;
}
if (gotZero) {
length += Tcl_GetCharLength(segment);
if (length < width) {
segmentLimit -= width - length;
}
while (length < width) {
Tcl_AppendToObj(segment, "0", 1);
length++;
}
}
if (toAppend > segmentLimit) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendObjToObj(segment, pure);
Tcl_DecrRefCount(pure);
break;
}
}
break;
}
case 'e':
case 'E':
case 'f':
case 'g':
case 'G': {
#define MAX_FLOAT_SIZE 320
char spec[2*TCL_INTEGER_SPACE + 9], *p = spec;
double d;
int length = MAX_FLOAT_SIZE;
char *bytes;
if (Tcl_GetDoubleFromObj(interp, segment, &d) != TCL_OK) {
/* TODO: Figure out ACCEPT_NAN here */
goto error;
}
*p++ = '%';
if (gotMinus) {
*p++ = '-';
}
if (gotHash) {
*p++ = '#';
}
if (gotZero) {
*p++ = '0';
}
if (gotSpace) {
*p++ = ' ';
}
if (gotPlus) {
*p++ = '+';
}
if (width) {
p += sprintf(p, "%d", width);
if (width > length) {
length = width;
}
}
if (gotPrecision) {
*p++ = '.';
p += sprintf(p, "%d", precision);
if (precision > INT_MAX - length) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
length += precision;
}
/*
* Don't pass length modifiers!
*/
*p++ = (char) ch;
*p = '\0';
segment = Tcl_NewObj();
allocSegment = 1;
if (!Tcl_AttemptSetObjLength(segment, length)) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
bytes = TclGetString(segment);
if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
break;
}
default:
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
}
goto error;
}
switch (ch) {
case 'E':
case 'G':
case 'X': {
Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
}
}
if (width>0 && numChars<0) {
numChars = Tcl_GetCharLength(segment);
}
if (!gotMinus && width>0) {
if (numChars < width) {
limit -= width - numChars;
}
while (numChars < width) {
Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
numChars++;
}
}
Tcl_GetStringFromObj(segment, &segmentNumBytes);
if (segmentNumBytes > limit) {
if (allocSegment) {
Tcl_DecrRefCount(segment);
}
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendObjToObj(appendObj, segment);
limit -= segmentNumBytes;
if (allocSegment) {
Tcl_DecrRefCount(segment);
}
if (width > 0) {
if (numChars < width) {
limit -= width-numChars;
}
while (numChars < width) {
Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
numChars++;
}
}
objIndex += gotSequential;
}
if (numBytes) {
if (numBytes > limit) {
msg = overflow;
errCode = "OVERFLOW";
goto errorMsg;
}
Tcl_AppendToObj(appendObj, span, numBytes);
limit -= numBytes;
numBytes = 0;
}
return TCL_OK;
errorMsg:
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
}
error:
Tcl_SetObjLength(appendObj, originalLength);
return TCL_ERROR;
}
/*
*---------------------------------------------------------------------------
*
* Tcl_Format--
*
* Results:
* A refcount zero Tcl_Obj.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_Format(
Tcl_Interp *interp,
const char *format,
int objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr = Tcl_NewObj();
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
if (result != TCL_OK) {
Tcl_DecrRefCount(objPtr);
return NULL;
}
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* AppendPrintfToObjVA --
*
* Results:
*
* Side effects:
*
*---------------------------------------------------------------------------
*/
static void
AppendPrintfToObjVA(
Tcl_Obj *objPtr,
const char *format,
va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
const char *p;
p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
int size = 0, seekingConversion = 1, gotPrecision = 0;
int lastNum = -1;
if (*p++ != '%') {
continue;
}
if (*p == '%') {
p++;
continue;
}
do {
switch (*p) {
case '\0':
seekingConversion = 0;
break;
case 's': {
const char *q, *end, *bytes = va_arg(argList, char *);
seekingConversion = 0;
/*
* The buffer to copy characters from starts at bytes and ends
* at either the first NUL byte, or after lastNum bytes, when
* caller has indicated a limit.
*/
end = bytes;
while ((!gotPrecision || lastNum--) && (*end != '\0')) {
end++;
}
/*
* Within that buffer, we trim both ends if needed so that we
* copy only whole characters, and avoid copying any partial
* multi-byte characters.
*/
q = Tcl_UtfPrev(end, bytes);
if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
end = q;
}
q = bytes + TCL_UTF_MAX;
while ((bytes < end) && (bytes < q)
&& ((*bytes & 0xC0) == 0x80)) {
bytes++;
}
Tcl_ListObjAppendElement(NULL, list,
Tcl_NewStringObj(bytes , (int)(end - bytes)));
break;
}
case 'c':
case 'i':
case 'u':
case 'd':
case 'o':
case 'x':
case 'X':
seekingConversion = 0;
switch (size) {
case -1:
case 0:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
(long) va_arg(argList, int)));
break;
case 1:
Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
va_arg(argList, long)));
break;
}
break;
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
va_arg(argList, double)));
seekingConversion = 0;
break;
case '*':
lastNum = (int) va_arg(argList, int);
Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
p++;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': {
char *end;
lastNum = (int) strtoul(p, &end, 10);
p = end;
break;
}
case '.':
gotPrecision = 1;
p++;
break;
/* TODO: support for wide (and bignum?) arguments */
case 'l':
size = 1;
p++;
break;
case 'h':
size = -1;
default:
p++;
}
} while (seekingConversion);
}
TclListObjGetElements(NULL, list, &objc, &objv);
code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
if (code != TCL_OK) {
Tcl_AppendPrintfToObj(objPtr,
"Unable to format \"%s\" with supplied arguments: %s",
format, Tcl_GetString(list));
}
Tcl_DecrRefCount(list);
}
/*
*---------------------------------------------------------------------------
*
* Tcl_AppendPrintfToObj --
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
void
Tcl_AppendPrintfToObj(
Tcl_Obj *objPtr,
const char *format,
...)
{
va_list argList;
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
}
/*
*---------------------------------------------------------------------------
*
* Tcl_ObjPrintf --
*
* Results:
* A refcount zero Tcl_Obj.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_ObjPrintf(
const char *format,
...)
{
va_list argList;
Tcl_Obj *objPtr = Tcl_NewObj();
va_start(argList, format);
AppendPrintfToObjVA(objPtr, format, argList);
va_end(argList);
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* TclGetStringStorage --
*
* Returns the string storage space of a Tcl_Obj.
*
* Results:
* The pointer value objPtr->bytes is returned and the number of bytes
* allocated there is written to *sizePtr (if known).
*
* Side effects:
* May set objPtr->bytes.
*
*---------------------------------------------------------------------------
*/
char *
TclGetStringStorage(
Tcl_Obj *objPtr,
unsigned int *sizePtr)
{
String *stringPtr;
if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) {
return TclGetStringFromObj(objPtr, (int *)sizePtr);
}
stringPtr = GET_STRING(objPtr);
*sizePtr = stringPtr->allocated;
return objPtr->bytes;
}
/*
*---------------------------------------------------------------------------
*
* TclStringObjReverse --
*
* Implements the [string reverse] operation.
*
* Results:
* An unshared Tcl value which is the [string reverse] of the argument
* supplied. When sharing rules permit, the returned value might be the
* argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
*
*---------------------------------------------------------------------------
*/
static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
if (to == from) {
/* Reversing in place */
while (--src > to) {
unsigned char c = *src;
*src = *to;
*to++ = c;
}
} else {
while (--src >= from) {
*to++ = *src;
}
}
}
Tcl_Obj *
TclStringObjReverse(
Tcl_Obj *objPtr)
{
String *stringPtr;
Tcl_UniChar ch;
if (TclIsPureByteArray(objPtr)) {
int numBytes;
unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
}
ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
return objPtr;
}
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode) {
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
if (Tcl_IsShared(objPtr)) {
Tcl_UniChar *to;
/*
* Create a non-empty, pure unicode value, so we can coax
* Tcl_SetObjLength into growing the unicode rep buffer.
*/
ch = 0;
objPtr = Tcl_NewUnicodeObj(&ch, 1);
Tcl_SetObjLength(objPtr, stringPtr->numChars);
to = Tcl_GetUnicode(objPtr);
while (--src >= from) {
*to++ = *src;
}
} else {
/* Reversing in place */
while (--src > from) {
ch = *src;
*src = *from;
*from++ = ch;
}
}
}
if (objPtr->bytes) {
int numChars = stringPtr->numChars;
int numBytes = objPtr->length;
char *to, *from = objPtr->bytes;
if (Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
Tcl_SetObjLength(objPtr, numBytes);
}
to = objPtr->bytes;
if (numChars < numBytes) {
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
* or numChars >= 0 and we know we have fewer chars than bytes,
* so we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
*/
int charCount = 0;
int bytesLeft = numBytes;
while (bytesLeft) {
/*
* NOTE: We know that the from buffer is NUL-terminated.
* It's part of the contract for objPtr->bytes values.
* Thus, we can skip calling Tcl_UtfCharComplete() here.
*/
int bytesInChar = Tcl_UtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
bytesInChar);
to += bytesInChar;
from += bytesInChar;
bytesLeft -= bytesInChar;
charCount++;
}
from = to = objPtr->bytes;
stringPtr->numChars = charCount;
}
/* Pass 2. Reverse all the bytes. */
ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
}
return objPtr;
}
/*
*---------------------------------------------------------------------------
*
* FillUnicodeRep --
*
* Populate the Unicode internal rep with the Unicode form of its string
* rep. The object must alread have a "String" internal rep.
*
* Results:
* None.
*
* Side effects:
* Reallocates the String internal rep.
*
*---------------------------------------------------------------------------
*/
static void
FillUnicodeRep(
Tcl_Obj *objPtr) /* The object in which to fill the unicode
* rep. */
{
String *stringPtr = GET_STRING(objPtr);
ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
stringPtr->numChars);
}
static void
ExtendUnicodeRepWithString(
Tcl_Obj *objPtr,
const char *bytes,
int numBytes,
int numAppendChars)
{
String *stringPtr = GET_STRING(objPtr);
int needed, numOrigChars = 0;
Tcl_UniChar *dst;
if (stringPtr->hasUnicode) {
numOrigChars = stringPtr->numChars;
}
if (numAppendChars == -1) {
TclNumUtfChars(numAppendChars, bytes, numBytes);
}
needed = numOrigChars + numAppendChars;
stringCheckLimits(needed);
if (needed > stringPtr->maxChars) {
GrowUnicodeBuffer(objPtr, needed);
stringPtr = GET_STRING(objPtr);
}
stringPtr->hasUnicode = 1;
if (bytes) {
stringPtr->numChars = needed;
} else {
numAppendChars = 0;
}
for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
bytes += TclUtfToUniChar(bytes, dst);
}
*dst = 0;
}
/*
*----------------------------------------------------------------------
*
* DupStringInternalRep --
*
* Initialize the internal representation of a new Tcl_Obj to a copy of
* the internal representation of an existing string object.
*
* Results:
* None.
*
* Side effects:
* copyPtr's internal rep is set to a copy of srcPtr's internal
* representation.
*
*----------------------------------------------------------------------
*/
static void
DupStringInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. Must have
* an internal rep of type "String". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
#if COMPAT==0
if (srcStringPtr->numChars == -1) {
/*
* The String struct in the source value holds zero useful data. Don't
* bother copying it. Don't even bother allocating space in which to
* copy it. Just let the copy be untyped.
*/
return;
}
if (srcStringPtr->hasUnicode) {
int copyMaxChars;
if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
copyMaxChars = 2 * srcStringPtr->numChars;
} else {
copyMaxChars = srcStringPtr->maxChars;
}
copyStringPtr = stringAttemptAlloc(copyMaxChars);
if (copyStringPtr == NULL) {
copyMaxChars = srcStringPtr->numChars;
copyStringPtr = stringAlloc(copyMaxChars);
}
copyStringPtr->maxChars = copyMaxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
srcStringPtr->numChars * sizeof(Tcl_UniChar));
copyStringPtr->unicode[srcStringPtr->numChars] = 0;
} else {
copyStringPtr = stringAlloc(0);
copyStringPtr->maxChars = 0;
copyStringPtr->unicode[0] = 0;
}
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
copyStringPtr->numChars = srcStringPtr->numChars;
/*
* Tricky point: the string value was copied by generic object management
* code, so it doesn't contain any extra bytes that might exist in the
* source object.
*/
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
#else /* COMPAT!=0 */
/*
* If the src obj is a string of 1-byte Utf chars, then copy the string
* rep of the source object and create an "empty" Unicode internal rep for
* the new object. Otherwise, copy Unicode internal rep, and invalidate
* the string rep of the new object.
*/
if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
/*
* Copy the full allocation for the Unicode buffer.
*/
copyStringPtr = stringAlloc(srcStringPtr->maxChars);
copyStringPtr->maxChars = srcStringPtr->maxChars;
memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
srcStringPtr->numChars * sizeof(Tcl_UniChar));
copyStringPtr->unicode[srcStringPtr->numChars] = 0;
copyStringPtr->allocated = 0;
} else {
copyStringPtr = stringAlloc(0);
copyStringPtr->unicode[0] = 0;
copyStringPtr->maxChars = 0;
/*
* Tricky point: the string value was copied by generic object
* management code, so it doesn't contain any extra bytes that might
* exist in the source object.
*/
copyStringPtr->allocated = copyPtr->length;
}
copyStringPtr->numChars = srcStringPtr->numChars;
copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
}
/*
*----------------------------------------------------------------------
*
* SetStringFromAny --
*
* Create an internal representation of type "String" for an object.
*
* Results:
* This operation always succeeds and returns TCL_OK.
*
* Side effects:
* Any old internal reputation for objPtr is freed and the internal
* representation is set to "String".
*
*----------------------------------------------------------------------
*/
static int
SetStringFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
if (objPtr->typePtr != &tclStringType) {
String *stringPtr = stringAlloc(0);
/*
* Convert whatever we have into an untyped value. Just A String.
*/
(void) TclGetString(objPtr);
TclFreeIntRep(objPtr);
/*
* Create a basic String intrep that just points to the UTF-8 string
* already in place at objPtr->bytes.
*/
stringPtr->numChars = -1;
stringPtr->allocated = objPtr->length;
stringPtr->maxChars = 0;
stringPtr->hasUnicode = 0;
SET_STRING(objPtr, stringPtr);
objPtr->typePtr = &tclStringType;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* UpdateStringOfString --
*
* Update the string representation for an object whose internal
* representation is "String".
*
* Results:
* None.
*
* Side effects:
* The object's string may be set by converting its Unicode represention
* to UTF format.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfString(
Tcl_Obj *objPtr) /* Object with string rep to update. */
{
String *stringPtr = GET_STRING(objPtr);
if (stringPtr->numChars == 0) {
TclInitStringRep(objPtr, tclEmptyStringRep, 0);
} else {
(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
stringPtr->numChars);
}
}
static int
ExtendStringRepWithUnicode(
Tcl_Obj *objPtr,
const Tcl_UniChar *unicode,
int numChars)
{
/*
* Pre-condition: this is the "string" Tcl_ObjType.
*/
int i, origLength, size = 0;
char *dst, buf[TCL_UTF_MAX];
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
numChars = UnicodeLength(unicode);
}
if (numChars == 0) {
return 0;
}
if (objPtr->bytes == NULL) {
objPtr->length = 0;
}
size = origLength = objPtr->length;
/*
* Quick cheap check in case we have more than enough room.
*/
if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
&& stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
goto copyBytes;
}
for (i = 0; i < numChars && size >= 0; i++) {
size += Tcl_UniCharToUtf((int) unicode[i], buf);
}
if (size < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
/*
* Grow space if needed.
*/
if (size > stringPtr->allocated) {
GrowStringBuffer(objPtr, size, 1);
}
copyBytes:
dst = objPtr->bytes + origLength;
for (i = 0; i < numChars; i++) {
dst += Tcl_UniCharToUtf((int) unicode[i], dst);
}
*dst = '\0';
objPtr->length = dst - objPtr->bytes;
return numChars;
}
/*
*----------------------------------------------------------------------
*
* FreeStringInternalRep --
*
* Deallocate the storage associated with a String data object's internal
* representation.
*
* Results:
* None.
*
* Side effects:
* Frees memory.
*
*----------------------------------------------------------------------
*/
static void
FreeStringInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
ckfree(GET_STRING(objPtr));
objPtr->typePtr = NULL;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/