paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 15:10:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Ported improvements from the AnsiString equivalents to NewWideString and

Browse Source 
fpc_WideStr_SetLength
This commit is contained in:
sg 2002-12-14 19:16:45 +00:00
parent 3214bab118
commit a384390a05
1 changed files with 37 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
rtl/inc/wstrings.inc
View File

@ -133,12 +133,16 @@ Function NewWideString(Len : Longint) : Pointer;
} }
Var Var
P : Pointer; P : Pointer;
l : Longint;
begin begin
{ Also add +1 for a terminating zero } l := Len + Len + WideRecLen;
GetMem(P,Len+Len+WideRecLen); { request a multiple of 16 because the heap manager alloctes anyways chunks of 16 bytes }
if (l mod 16)<>0 then
inc(l,16-(l mod 16));
GetMem(P,l);
If P<>Nil then If P<>Nil then
begin begin
PWideRec(P)^.Maxlen:=Len; { Maximal length } PWideRec(P)^.Maxlen:=(l-WideRecLen) div 2; { Maximal length }
PWideRec(P)^.Len:=0; { Initial length } PWideRec(P)^.Len:=0; { Initial length }
PWideRec(P)^.Ref:=1; { Set reference count } PWideRec(P)^.Ref:=1; { Set reference count }
PWideRec(P)^.First:=#0; { Terminating #0 } PWideRec(P)^.First:=#0; { Terminating #0 }
@ -535,6 +539,7 @@ Procedure fpc_WideStr_SetLength (Var S : WideString; l : Longint);[Public,Alias
} }
Var Var
Temp : Pointer; Temp : Pointer;
movelen, NewLen: longint;
begin begin
if (l>0) then if (l>0) then
begin begin
@ -543,26 +548,43 @@ begin
{ Need a complete new string...} { Need a complete new string...}
Pointer(s):=NewWideString(l); Pointer(s):=NewWideString(l);
end end
else if (PWideRec(Pointer(S)-WideFirstOff)^.Ref = 1) then
begin
if (PWideRec(Pointer(S)-WideFirstOff)^.Maxlen < L) then
begin
Dec(Pointer(S),WideFirstOff);
NewLen := (L+L+WideRecLen+15) and not 15;
reallocmem(pointer(S), NewLen);
PAnsiRec(S)^.MaxLen := (NewLen - WideRecLen) div 2;
Inc(Pointer(S), WideFirstOff);
end;
PWideRec(Pointer(S)-WideFirstOff)^.Len := L;
PWord(Pointer(S)+L+L)^:=0;
end
else else
If (PWideRec(Pointer(S)-WideFirstOff)^.Maxlen < L) or
(PWideRec(Pointer(S)-WideFirstOff)^.Ref <> 1) then
begin begin
{ Reallocation is needed... } { Reallocation is needed... }
Temp:=Pointer(NewWideString(L)); Temp:=Pointer(NewWideString(L));
if Length(S)>0 then if Length(S)>0 then
Move(Pointer(S)^,Temp^,L*sizeof(WideChar)); begin
fpc_WideStr_decr_ref(Pointer(S)); if l < succ(length(s)) then
movelen := l
{ also move terminating null }
else movelen := succ(length(s));
Move(Pointer(S)^,Temp^,movelen * Sizeof(WideChar));
end;
fpc_widestr_decr_ref(Pointer(S));
Pointer(S):=Temp; Pointer(S):=Temp;
end; end;
{ Force nil termination in case it gets shorter } { Force nil termination in case it gets shorter }
PWideChar(Pointer(S)+l*sizeof(WideChar))^:=#0; PWord(Pointer(S)+l+l)^:=0;
PWideRec(Pointer(S)-WideFirstOff)^.Len:=l; PWideRec(Pointer(S)-FirstOff)^.Len:=l;
end end
else else
begin begin
{ Length=0 } { Length=0 }
if Pointer(S)<>nil then if Pointer(S)<>nil then
fpc_WideStr_decr_ref (Pointer(S)); fpc_widestr_decr_ref (Pointer(S));
Pointer(S):=Nil; Pointer(S):=Nil;
end; end;
end; end;
@ -913,7 +935,11 @@ end;
{ {
$Log$ $Log$
Revision 1.25 2002-12-07 14:35:34 carl Revision 1.26 2002-12-14 19:16:45 sg
* Ported improvements from the AnsiString equivalents to NewWideString and
fpc_WideStr_SetLength
Revision 1.25 2002/12/07 14:35:34 carl
- avoid warnings (add typecast) - avoid warnings (add typecast)
Revision 1.24 2002/10/10 16:08:50 florian Revision 1.24 2002/10/10 16:08:50 florian