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

- Cleaned out FPC_STRTOSHORTSTRPROC and FPC_STRTOCHARARRAYPROC defines. Somebody had to do it one day.

Browse Source 
git-svn-id: trunk@19851 -
This commit is contained in:
sergei 2011-12-14 22:40:08 +00:00
parent 3106e57631
commit 724f41a9af
7 changed files with 0 additions and 621 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
rtl/i386/i386.inc
View File

@ -655,52 +655,6 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
begin
asm
{$ifdef FPC_PROFILE}
push %eax
push %edx
push %ecx
call mcount
pop %ecx
pop %edx
pop %eax
{$endif FPC_PROFILE}
cld
movl __RESULT,%edi
movl sstr,%esi
xorl %eax,%eax
movl len,%ecx
lodsb
cmpl %ecx,%eax
jbe .LStrCopy1
movl %ecx,%eax
.LStrCopy1:
stosb
cmpl $7,%eax
jl .LStrCopy2
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
rep
movsb
movl %eax,%ecx
andl $3,%eax
shrl $2,%ecx
rep
movsl
.LStrCopy2:
movl %eax,%ecx
rep
movsb
end ['ESI','EDI','EAX','ECX'];
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);assembler;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc; procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);assembler;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
var var
saveesi,saveedi : longint; saveesi,saveedi : longint;
@ -747,7 +701,6 @@ procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring)
movl saveedi,%edi movl saveedi,%edi
movl saveesi,%esi movl saveesi,%esi
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
@ -997,10 +950,6 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_to_shortstr(p:pchar):shortstring;assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
{$include strpas.inc}
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
var var
saveres,saveebx,saveesi,saveedi : longint; saveres,saveebx,saveesi,saveedi : longint;
@ -1093,7 +1042,6 @@ asm
movl saveedi,%edi movl saveedi,%edi
movl saveebx,%ebx movl saveebx,%ebx
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} {$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}

51
rtl/inc/astrings.inc
View File

@ -431,33 +431,6 @@ end;
Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR']; Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR'];
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
{ the following declaration has exactly the same effect as }
{ procedure fpc_AnsiStr_To_ShortStr (Var S1 : ShortString;S2 : Pointer); }
{ which is what the old helper was, so we don't need an extra implementation }
{ of the old helper (JM) }
function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; [Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc;
{
Converts a AnsiString to a ShortString;
}
Var
Size : SizeInt;
begin
if S2='' then
fpc_AnsiStr_To_ShortStr:=''
else
begin
Size:=Length(S2);
If Size>high_of_res then
Size:=high_of_res;
Move (S2[1],fpc_AnsiStr_To_ShortStr[1],Size);
byte(fpc_AnsiStr_To_ShortStr[0]):=byte(Size);
end;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : RawByteString);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc; procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : RawByteString);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc;
{ {
Converts a AnsiString to a ShortString; Converts a AnsiString to a ShortString;
@ -477,7 +450,6 @@ begin
end; end;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc; Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
@ -588,27 +560,6 @@ begin
end; end;
end; end;
{$ifndef FPC_STRTOCHARARRAYPROC}
{ note: inside the compiler, the resulttype is modified to be the length }
{ of the actual chararray to which we convert (JM) }
function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; [public, alias: 'FPC_ANSISTR_TO_CHARARRAY']; compilerproc;
var
len: SizeInt;
begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_ansistr_to_chararray[0],len);
{ fpc_big_chararray is defined as array[0..0], see compproc.inc why }
fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: RawByteString); compilerproc; procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: RawByteString); compilerproc;
var var
@ -621,12 +572,10 @@ begin
{ make sure we don't try to access element 1 of the ansistring if it's nil } { make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then if len > 0 then
move(src[1],res[0],len); move(src[1],res[0],len);
{ fpc_big_chararray is defined as array[0..0], see compproc.inc why }
fillchar(res[len],length(res)-len,0); fillchar(res[len],length(res)-len,0);
{$pop} {$pop}
end; end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE']; compilerproc; Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE']; compilerproc;
{ {

78
rtl/inc/compproc.inc
View File

@ -23,15 +23,6 @@
{ some dummy types necessary to have generic resulttypes for certain compilerprocs } { some dummy types necessary to have generic resulttypes for certain compilerprocs }
type type
{ normally the array should be maxlongint big, but that will confuse
the debugger. The compiler will set the correct size of the array
internally. It's now set to 0..0 because when compiling with -gt,
the entire array will be trashed, so it must not be defined larger
than the minimal size (otherwise we can trash other memory) }
{$ifndef FPC_STRTOCHARARRAYPROC}
fpc_big_chararray = array[0..0] of char;
fpc_big_widechararray = array[0..0] of widechar;
{$endif ndef FPC_STRTOCHARARRAYPROC}
fpc_small_set = bitpacked array[0..31] of 0..1; fpc_small_set = bitpacked array[0..31] of 0..1;
fpc_normal_set = bitpacked array[0..255] of 0..1; fpc_normal_set = bitpacked array[0..255] of 0..1;
fpc_normal_set_byte = array[0..31] of byte; fpc_normal_set_byte = array[0..31] of byte;
@ -45,11 +36,7 @@ Procedure fpc_freemem(p:pointer);compilerproc;
{$endif FPC_HAS_FEATURE_HEAP} {$endif FPC_HAS_FEATURE_HEAP}
procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc; procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc; procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifndef STR_CONCAT_PROCS} {$ifndef STR_CONCAT_PROCS}
function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc; function fpc_shortstr_concat(const s1,s2:shortstring): shortstring; compilerproc;
@ -61,25 +48,13 @@ procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);
function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc; function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc; function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_to_shortstr(p:pchar):shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc; procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_length(p:pchar):sizeint; compilerproc; function fpc_pchar_length(p:pchar):sizeint; compilerproc;
function fpc_pwidechar_length(p:pwidechar):sizeint; compilerproc; function fpc_pwidechar_length(p:pwidechar):sizeint; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true); compilerproc; procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc; procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc; Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc; function fpc_char_copy(c:char;index : SizeInt;count : SizeInt): shortstring;compilerproc;
@ -248,11 +223,7 @@ function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring;
{$ifdef EXTRAANSISHORT} {$ifdef EXTRAANSISHORT}
Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc; Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
{$endif EXTRAANSISHORT} {$endif EXTRAANSISHORT}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : RawByteString); compilerproc; procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : RawByteString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc; Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -261,11 +232,7 @@ Function fpc_Char_To_AnsiStr(const c : AnsiChar{$ifdef FPC_HAS_CPSTRING};cp : TS
Function fpc_PChar_To_AnsiStr(const p : PAnsiChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc; Function fpc_PChar_To_AnsiStr(const p : PAnsiChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
Function fpc_CharArray_To_AnsiStr(const arr: array of AnsiChar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): RawByteString; compilerproc; Function fpc_CharArray_To_AnsiStr(const arr: array of AnsiChar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): RawByteString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: RawByteString)compilerproc; procedure fpc_ansistr_to_chararray(out res: array of AnsiChar; const src: RawByteString)compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt; compilerproc; Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt; compilerproc;
Function fpc_AnsiStr_Compare_equal(const S1,S2 : RawByteString): SizeInt; compilerproc; Function fpc_AnsiStr_Compare_equal(const S1,S2 : RawByteString): SizeInt; compilerproc;
{$ifdef VER2_4} {$ifdef VER2_4}
@ -295,11 +262,7 @@ Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc; Procedure fpc_WideStr_Decr_Ref (Var S : Pointer); compilerproc;
Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc; Procedure fpc_WideStr_Incr_Ref (Var S : Pointer); compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); compilerproc; procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc; Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc; Function fpc_WideStr_To_AnsiStr (const S2 : WideString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc; Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc;
@ -314,13 +277,8 @@ Procedure fpc_WideStr_Concat_multi (Var DestS : Widestring;const sarr:array of W
Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc; Function fpc_Char_To_WideStr(const c : Char): WideString; compilerproc;
Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc; Function fpc_PChar_To_WideStr(const p : pchar): WideString; compilerproc;
Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc; Function fpc_CharArray_To_WideStr(const arr: array of char; zerobased: boolean = true): WideString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray; compilerproc;
Function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc; procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc; procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc; Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc; Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
{$ifdef VER2_4} {$ifdef VER2_4}
@ -354,11 +312,7 @@ Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_UnicodeStr_Decr_Ref (Var S : Pointer); compilerproc; Procedure fpc_UnicodeStr_Decr_Ref (Var S : Pointer); compilerproc;
Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer); compilerproc; Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer); compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeString): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc; procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc; Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc; Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
Function fpc_AnsiStr_To_UnicodeStr (Const S2 : RawByteString): UnicodeString; compilerproc; Function fpc_AnsiStr_To_UnicodeStr (Const S2 : RawByteString): UnicodeString; compilerproc;
@ -375,40 +329,20 @@ Procedure fpc_UnicodeStr_Concat_multi (Var DestS : Unicodestring;const sarr:arra
Function fpc_Char_To_UnicodeStr(const c : Char): UnicodeString; compilerproc; Function fpc_Char_To_UnicodeStr(const c : Char): UnicodeString; compilerproc;
Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc; Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
Function fpc_CharArray_To_UnicodeStr(const arr: array of char; zerobased: boolean = true): UnicodeString; compilerproc; Function fpc_CharArray_To_UnicodeStr(const arr: array of char; zerobased: boolean = true): UnicodeString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_unicodestr_to_chararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_chararray; compilerproc;
Function fpc_shortstr_to_unicodechararray(arraysize: SizeInt; const src: ShortString): fpc_big_unicodechararray; compilerproc;
Function fpc_ansistr_to_unicodechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_unicodechararray; compilerproc;
Function fpc_unicodestr_to_unicodechararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_unicodechararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_unicodestr_to_chararray(out res: array of char; const src: UnicodeString); compilerproc; procedure fpc_unicodestr_to_chararray(out res: array of char; const src: UnicodeString); compilerproc;
procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc; procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc; procedure fpc_ansistr_to_unicodechararray(out res: array of unicodechar; const src: AnsiString); compilerproc;
procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc; procedure fpc_unicodestr_to_unicodechararray(out res: array of unicodechar; const src: UnicodeString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerobased: boolean = true): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc; procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc; Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc; Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc; procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc; Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc; Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc; Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc; procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: RawByteString); compilerproc; procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: RawByteString); compilerproc;
procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc; procedure fpc_unicodestr_to_widechararray(out res: array of widechar; const src: UnicodeString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc; Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc; Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
{$ifdef VER2_4} {$ifdef VER2_4}
@ -427,11 +361,7 @@ Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc; Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc; Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc; Function fpc_UChar_To_AnsiStr(const c : UnicodeChar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): AnsiString; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc; procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@ -440,22 +370,14 @@ Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar{$ifdef FPC_HAS_CPSTR
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc; Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc; Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc; procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc; Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc; procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS} {$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS} {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

96
rtl/inc/generic.inc
View File

@ -863,19 +863,6 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN} {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_shortstr_to_shortstr(len:longint;const sstr:shortstring): shortstring;[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
var
slen : byte;
begin
slen:=length(sstr);
if slen<len then
len:=slen;
move(sstr[0],result[0],len+1);
if slen>len then
result[0]:=chr(len);
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc; procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
var var
slen : byte; slen : byte;
@ -886,7 +873,6 @@ begin
move(sstr[0],res[0],slen+1); move(sstr[0],res[0],slen+1);
res[0]:=chr(slen); res[0]:=chr(slen);
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif} procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
var var
@ -1079,25 +1065,6 @@ end;
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_to_shortstr(p:pchar):shortstring;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
var
l : longint;
s: shortstring;
begin
if p=nil then
l:=0
else
l:=strlen(p);
if l>255 then
l:=255;
if l>0 then
move(p^,s[1],l);
s[0]:=chr(l);
fpc_pchar_to_shortstr := s;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc; procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
var var
@ -1116,60 +1083,21 @@ begin
res:=s; res:=s;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR} {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
{ also define alias which can be used inside the system unit }
function fpc_pchar_to_shortstr(p:pchar):shortstring;[external name 'FPC_PCHAR_TO_SHORTSTR'];
{$else FPC_STRTOSHORTSTRINGPROC}
{ also define alias which can be used inside the system unit } { also define alias which can be used inside the system unit }
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR']; procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR'];
{$endif FPC_STRTOSHORTSTRINGPROC}
function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif} function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
begin begin
{$ifndef FPC_STRTOSHORTSTRINGPROC}
result:=fpc_pchar_to_shortstr(p);
{$else FPC_STRTOSHORTSTRINGPROC}
fpc_pchar_to_shortstr(result,p); fpc_pchar_to_shortstr(result,p);
{$endif FPC_STRTOSHORTSTRINGPROC}
end; end;
{$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR} {$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring;[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
var
l: longint;
index: longint;
len: byte;
begin
l := high(arr)+1;
if l>=256 then
l:=255
else if l<0 then
l:=0;
if (zerobased) then
begin
index:=IndexByte(arr[0],l,0);
if (index < 0) then
len := l
else
len := index;
end
else
len := l;
move(arr[0],fpc_chararray_to_shortstr[1],len);
fpc_chararray_to_shortstr[0]:=chr(len);
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true);[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc; procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true);[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
var var
l: longint; l: longint;
@ -1194,34 +1122,12 @@ begin
move(arr[0],res[1],len); move(arr[0],res[1],len);
res[0]:=chr(len); res[0]:=chr(len);
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR} {$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY} {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
{$ifndef FPC_STRTOCHARARRAYPROC}
{ inside the compiler, the resulttype is modified to that of the actual }
{ chararray we're converting to (JM) }
function fpc_shortstr_to_chararray(arraysize: longint; const src: ShortString): fpc_big_chararray;[public,alias: 'FPC_SHORTSTR_TO_CHARARRAY']; compilerproc;
var
len: longint;
begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}{$r-}
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
move(src[1],fpc_shortstr_to_chararray[0],len);
fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc; procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
var var
len: longint; len: longint;
@ -1237,8 +1143,6 @@ begin
{$pop} {$pop}
end; end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY} {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH} {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

12
rtl/inc/strings.pp
View File

@ -120,25 +120,13 @@ implementation
{ Functions, different from the one in sysutils } { Functions, different from the one in sysutils }
{$ifndef FPC_STRTOSHORTSTRINGPROC}
{ also define alias which can be used inside the system unit }
function fpc_pchar_to_shortstr(p:pchar):shortstring;[external name 'FPC_PCHAR_TO_SHORTSTR'];
{$else FPC_STRTOSHORTSTRINGPROC}
{ also define alias which can be used inside the system unit }
procedure fpc_pchar_to_shortstr(var res : openstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR']; procedure fpc_pchar_to_shortstr(var res : openstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR'];
{$endif FPC_STRTOSHORTSTRINGPROC}
function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif} function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
begin begin
{$ifndef FPC_STRTOSHORTSTRINGPROC}
strpas:=fpc_pchar_to_shortstr(p);
{$else FPC_STRTOSHORTSTRINGPROC}
fpc_pchar_to_shortstr(strpas,p); fpc_pchar_to_shortstr(strpas,p);
{$endif FPC_STRTOSHORTSTRINGPROC}
end; end;
function stralloc(L : SizeInt) : pchar; function stralloc(L : SizeInt) : pchar;

224
rtl/inc/ustrings.inc
View File

@ -243,26 +243,6 @@ Procedure fpc_UnicodeStr_Incr_Ref(S : Pointer);[Public,Alias:'FPC_UNICODESTR_INC
{ alias for internal use } { alias for internal use }
Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer);[external name 'FPC_UNICODESTR_INCR_REF']; Procedure fpc_UnicodeStr_Incr_Ref (S : Pointer);[external name 'FPC_UNICODESTR_INCR_REF'];
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeString): shortstring;[Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR']; compilerproc;
{
Converts a UnicodeString to a ShortString;
}
Var
Size : SizeInt;
temp : ansistring;
begin
result:='';
Size:=Length(S2);
if Size>0 then
begin
If Size>high_of_res then
Size:=high_of_res;
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
result:=temp;
end;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc; procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); [Public, alias: 'FPC_UNICODESTR_TO_SHORTSTR'];compilerproc;
{ {
Converts a UnicodeString to a ShortString; Converts a UnicodeString to a ShortString;
@ -281,7 +261,6 @@ begin
res:=temp; res:=temp;
end; end;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString;compilerproc; Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString;compilerproc;
@ -407,23 +386,6 @@ begin
end; end;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PUnicodeChar_To_ShortStr(const p : punicodechar): shortstring; compilerproc;
var
Size : SizeInt;
temp: ansistring;
begin
result:='';
if p=nil then
exit;
Size := IndexWord(p^, $7fffffff, 0);
if Size>0 then
begin
widestringmanager.Unicode2AnsiMoveProc(p,temp,Size);
result:=temp;
end;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc; procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodechar); compilerproc;
var var
Size : SizeInt; Size : SizeInt;
@ -439,7 +401,6 @@ begin
res:=temp; res:=temp;
end; end;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc; Function fpc_PWideChar_To_AnsiStr(const p : pwidechar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): ansistring; compilerproc;
@ -461,23 +422,6 @@ begin
end; end;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;
var
Size : SizeInt;
temp: ansistring;
begin
result:='';
if p=nil then
exit;
Size := IndexWord(p^, $7fffffff, 0);
if Size>0 then
begin
widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
result:=temp;
end;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc; procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar); compilerproc;
var var
Size : SizeInt; Size : SizeInt;
@ -493,7 +437,6 @@ begin
res:=temp; res:=temp;
end; end;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{ checked against the ansistring routine, 2001-05-27 (FK) } { checked against the ansistring routine, 2001-05-27 (FK) }
@ -748,18 +691,6 @@ begin
end; end;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
{
Converts a WideChar to a ShortString;
}
var
s: ansistring;
begin
widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
fpc_WChar_To_ShortStr:= s;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc; procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compilerproc;
{ {
Converts a WideChar to a ShortString; Converts a WideChar to a ShortString;
@ -770,7 +701,6 @@ begin
widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1); widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s; res:=s;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc; Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
@ -801,18 +731,6 @@ begin
end; end;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_UChar_To_ShortStr(const c : UnicodeChar): ShortString; compilerproc;
{
Converts a UnicodeChar to a ShortString;
}
var
s: ansistring;
begin
widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
fpc_UChar_To_ShortStr:= s;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc; procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) compilerproc;
{ {
Converts a UnicodeChar to a ShortString; Converts a UnicodeChar to a ShortString;
@ -823,7 +741,6 @@ begin
widestringmanager.Unicode2AnsiMoveProc(@c,s,DefaultSystemCodePage,1); widestringmanager.Unicode2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s; res:=s;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc; Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
@ -862,33 +779,6 @@ begin
end; end;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_UNICODECHARARRAY_TO_SHORTSTR']; compilerproc;
var
l: longint;
index: longint;
len: byte;
temp: ansistring;
begin
l := high(arr)+1;
if l>=256 then
l:=255
else if l<0 then
l:=0;
if zerobased then
begin
index:=IndexWord(arr[0],l,0);
if (index < 0) then
len := l
else
len := index;
end
else
len := l;
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,len);
fpc_UnicodeCharArray_To_ShortStr := temp;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true);[public,alias:'FPC_UNICODECHARARRAY_TO_SHORTSTR']; compilerproc; procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true);[public,alias:'FPC_UNICODECHARARRAY_TO_SHORTSTR']; compilerproc;
var var
l: longint; l: longint;
@ -914,7 +804,6 @@ begin
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,DefaultSystemCodePage,len); widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp; res:=temp;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): AnsiString; compilerproc; Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): AnsiString; compilerproc;
var var
@ -975,33 +864,6 @@ end;
{ due to their names, the following procedures should be in wstrings.inc, { due to their names, the following procedures should be in wstrings.inc,
however, the compiler generates code using this functions on all platforms } however, the compiler generates code using this functions on all platforms }
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring;[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
var
l: longint;
index: longint;
len: byte;
temp: ansistring;
begin
l := high(arr)+1;
if l>=256 then
l:=255
else if l<0 then
l:=0;
if zerobased then
begin
index:=IndexWord(arr[0],l,0);
if (index < 0) then
len := l
else
len := index;
end
else
len := l;
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
fpc_WideCharArray_To_ShortStr := temp;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true);[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc; procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true);[public,alias:'FPC_WIDECHARARRAY_TO_SHORTSTR']; compilerproc;
var var
l: longint; l: longint;
@ -1027,7 +889,6 @@ begin
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,DefaultSystemCodePage,len); widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp; res:=temp;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc; Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING} zerobased: boolean = true): AnsiString; compilerproc;
var var
@ -1067,90 +928,6 @@ begin
Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar)); Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar));
end; end;
{$ifndef FPC_STRTOCHARARRAYPROC}
{ inside the compiler, the resulttype is modified to that of the actual }
{ chararray we're converting to (JM) }
function fpc_unicodestr_to_chararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_chararray;[public,alias: 'FPC_UNICODESTR_TO_CHARARRAY']; compilerproc;
var
len: SizeInt;
temp: ansistring;
begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.unicode2ansimoveproc(punicodechar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_unicodestr_to_chararray[0],len);
fillchar(fpc_unicodestr_to_chararray[len],arraysize-len,0);
{$pop}
end;
{ inside the compiler, the resulttype is modified to that of the actual }
{ unicodechararray we're converting to (JM) }
function fpc_unicodestr_to_unicodechararray(arraysize: SizeInt; const src: UnicodeString): fpc_big_unicodechararray;[public,alias: 'FPC_UNICODESTR_TO_UNICODECHARARRAY']; compilerproc;
var
len: SizeInt;
begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_unicodestr_to_unicodechararray[0],len*SizeOf(UnicodeChar));
fillchar(fpc_unicodestr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$pop}
end;
{ inside the compiler, the resulttype is modified to that of the actual }
{ chararray we're converting to (JM) }
function fpc_ansistr_to_unicodechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_unicodechararray;[public,alias: 'FPC_ANSISTR_TO_UNICODECHARARRAY']; compilerproc;
var
len: SizeInt;
temp: unicodestring;
begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_ansistr_to_unicodechararray[0],len*sizeof(unicodechar));
fillchar(fpc_ansistr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$pop}
end;
function fpc_shortstr_to_unicodechararray(arraysize: SizeInt; const src: ShortString): fpc_big_unicodechararray;[public,alias: 'FPC_SHORTSTR_TO_UNICODECHARARRAY']; compilerproc;
var
len: longint;
temp : unicodestring;
begin
len := length(src);
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_shortstr_to_unicodechararray[0],len*sizeof(unicodechar));
fillchar(fpc_shortstr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_unicodestr_to_chararray(out res: array of char; const src: UnicodeString); compilerproc; procedure fpc_unicodestr_to_chararray(out res: array of char; const src: UnicodeString); compilerproc;
var var
@ -1283,7 +1060,6 @@ begin
end; end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt;[Public,Alias : 'FPC_UNICODESTR_COMPARE']; compilerproc; Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt;[Public,Alias : 'FPC_UNICODESTR_COMPARE']; compilerproc;
{ {

108
rtl/inc/wstrings.inc
View File

@ -179,26 +179,6 @@ Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_
{ alias for internal use } { alias for internal use }
Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF']; Procedure fpc_WideStr_Incr_Ref (Var S : Pointer);[external name 'FPC_WIDESTR_INCR_REF'];
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): shortstring;[Public, alias: 'FPC_WIDESTR_TO_SHORTSTR']; compilerproc;
{
Converts a WideString to a ShortString;
}
Var
Size : SizeInt;
temp : ansistring;
begin
result:='';
Size:=Length(S2);
if Size>0 then
begin
If Size>high_of_res then
Size:=high_of_res;
widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
result:=temp;
end;
end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc; procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); [Public, alias: 'FPC_WIDESTR_TO_SHORTSTR'];compilerproc;
{ {
Converts a WideString to a ShortString; Converts a WideString to a ShortString;
@ -217,7 +197,6 @@ begin
res:=temp; res:=temp;
end; end;
end; end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc; Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
@ -535,92 +514,6 @@ begin
end; end;
{$ifndef FPC_STRTOCHARARRAYPROC}
{ inside the compiler, the resulttype is modified to that of the actual }
{ chararray we're converting to (JM) }
function fpc_widestr_to_chararray(arraysize: SizeInt; const src: WideString): fpc_big_chararray;[public,alias: 'FPC_WIDESTR_TO_CHARARRAY']; compilerproc;
var
len: SizeInt;
temp: ansistring;
begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_widestr_to_chararray[0],len);
fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
{$pop}
end;
{ inside the compiler, the resulttype is modified to that of the actual }
{ widechararray we're converting to (JM) }
function fpc_widestr_to_widechararray(arraysize: SizeInt; const src: WideString): fpc_big_widechararray;[public,alias: 'FPC_WIDESTR_TO_WIDECHARARRAY']; compilerproc;
var
len: SizeInt;
begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$pop}
end;
{ inside the compiler, the resulttype is modified to that of the actual }
{ chararray we're converting to (JM) }
function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray;[public,alias: 'FPC_ANSISTR_TO_WIDECHARARRAY']; compilerproc;
var
len: SizeInt;
temp: widestring;
begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$pop}
end;
function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
var
len: longint;
temp : widestring;
begin
len := length(src);
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc; procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); compilerproc;
var var
len: SizeInt; len: SizeInt;
@ -658,7 +551,6 @@ begin
end; end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc; Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
{ {