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

* forgotten part of r14432

Browse Source 
git-svn-id: trunk@14433 -
This commit is contained in:
florian 2009-12-13 11:18:49 +00:00
parent b5e7b3e1e7
commit 7a82669942
2 changed files with 40 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
rtl/inc/wstrings.inc
View File

@ -53,15 +53,18 @@ Const
procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
var
i : SizeInt;
destp: PChar;
begin
setlength(dest,len);
destp := PChar(Pointer(dest));
for i:=1 to len do
begin
if word(source^)<256 then
dest[i]:=char(word(source^))
destp^:=char(word(source^))
else
dest[i]:='?';
destp^:='?';
inc(source);
inc(destp);
end;
end;
@ -173,31 +176,13 @@ begin
S:=Nil;
end;
var
__data_start: byte; external name '__data_start__';
__data_end: byte; external name '__data_end__';
function IsWideStringConstant(S: pointer): boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
{
Returns True if widestring is constant (located in .data section);
}
begin
Result:=(S>=@__data_start) and (S<@__data_end);
end;
Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; compilerproc;
{
Decreases the ReferenceCount of a non constant widestring;
If the reference count is zero, deallocate the string;
}
Type
pSizeInt = ^SizeInt;
Begin
{ Zero string }
if S=Nil then
exit;
if not IsWideStringConstant(S) then
DisposeWideString(S);
DisposeWideString(S); { does test for nil }
end;
{ alias for internal use }
@ -331,12 +316,6 @@ begin
if S1=S2 then exit;
if S2<>nil then
begin
if IsWideStringConstant(S1) then
begin
S1:=NewWidestring(length(WideString(S2)));
move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
end
else
{$ifdef MSWINDOWS}
if winwidestringalloc then
begin
@ -787,7 +766,7 @@ begin
{$ifdef MSWINDOWS}
not winwidestringalloc and
{$endif MSWINDOWS}
not IsWideStringConstant(pointer(S))
True
then
begin
Dec(Pointer(S),WideFirstOff);

33
rtl/win/syswin.inc
View File

@ -258,11 +258,44 @@ function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
CharLowerBuff(LPWSTR(result),length(result));
end;
type
PWStrInitEntry = ^TWStrInitEntry;
TWStrInitEntry = record
addr: PPointer;
data: Pointer;
end;
PWStrInitTablesTable = ^TWStrInitTablesTable;
TWStrInitTablesTable = packed record
count : longint;
tables : packed array [1..32767] of PWStrInitEntry;
end;
{$ifndef VER2_4}
var
WStrInitTablesTable: TWStrInitTablesTable; external name 'FPC_WIDEINITTABLES';
{$endif VER2_4}
{ there is a similiar procedure in sysutils which inits the fields which
are only relevant for the sysutils units }
procedure InitWin32Widestrings;
var
i: longint;
ptable: PWStrInitEntry;
begin
{$ifndef VER2_4}
{ assign initial values to global Widestring typed consts }
for i:=1 to WStrInitTablesTable.count do
begin
ptable:=WStrInitTablesTable.tables[i];
while Assigned(ptable^.addr) do
begin
fpc_widestr_assign(ptable^.addr^, ptable^.data);
Inc(ptable);
end;
end;
{$endif VER2_4}
{ Widestring }
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;