paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 13:49: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); procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
var var
i : SizeInt; i : SizeInt;
destp: PChar;
begin begin
setlength(dest,len); setlength(dest,len);
destp := PChar(Pointer(dest));
for i:=1 to len do for i:=1 to len do
begin begin
if word(source^)<256 then if word(source^)<256 then
dest[i]:=char(word(source^)) destp^:=char(word(source^))
else else
dest[i]:='?'; destp^:='?';
inc(source); inc(source);
inc(destp);
end; end;
end; end;
@ -173,31 +176,13 @@ begin
S:=Nil; S:=Nil;
end; 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; Procedure fpc_WideStr_Decr_Ref (Var S : Pointer);[Public,Alias:'FPC_WIDESTR_DECR_REF']; compilerproc;
{ {
Decreases the ReferenceCount of a non constant widestring; Decreases the ReferenceCount of a non constant widestring;
If the reference count is zero, deallocate the string; If the reference count is zero, deallocate the string;
} }
Type
pSizeInt = ^SizeInt;
Begin Begin
{ Zero string } DisposeWideString(S); { does test for nil }
if S=Nil then
exit;
if not IsWideStringConstant(S) then
DisposeWideString(S);
end; end;
{ alias for internal use } { alias for internal use }
@ -331,12 +316,6 @@ begin
if S1=S2 then exit; if S1=S2 then exit;
if S2<>nil then if S2<>nil then
begin begin
if IsWideStringConstant(S1) then
begin
S1:=NewWidestring(length(WideString(S2)));
move(s2^,s1^,(length(WideString(s1))+1)*sizeof(widechar));
end
else
{$ifdef MSWINDOWS} {$ifdef MSWINDOWS}
if winwidestringalloc then if winwidestringalloc then
begin begin
@ -787,7 +766,7 @@ begin
{$ifdef MSWINDOWS} {$ifdef MSWINDOWS}
not winwidestringalloc and not winwidestringalloc and
{$endif MSWINDOWS} {$endif MSWINDOWS}
not IsWideStringConstant(pointer(S)) True
then then
begin begin
Dec(Pointer(S),WideFirstOff); 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)); CharLowerBuff(LPWSTR(result),length(result));
end; 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 { there is a similiar procedure in sysutils which inits the fields which
are only relevant for the sysutils units } are only relevant for the sysutils units }
procedure InitWin32Widestrings; procedure InitWin32Widestrings;
var
i: longint;
ptable: PWStrInitEntry;
begin 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 } { Widestring }
widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove; widestringmanager.Wide2AnsiMoveProc:=@Win32Wide2AnsiMove;
widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove; widestringmanager.Ansi2WideMoveProc:=@Win32Ansi2WideMove;