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

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

View File

@ -655,52 +655,6 @@ end;
{$ifndef 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;
var
saveesi,saveedi : longint;
@ -747,7 +701,6 @@ procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring)
movl saveedi,%edi
movl saveesi,%esi
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
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}
{$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;
var
saveres,saveebx,saveesi,saveedi : longint;
@ -1093,7 +1042,6 @@ asm
movl saveedi,%edi
movl saveebx,%ebx
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}

View File

@ -431,33 +431,6 @@ end;
Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; [external name 'FPC_ANSISTR_TO_ANSISTR'];
{$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;
{
Converts a AnsiString to a ShortString;
@ -477,7 +450,6 @@ begin
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;
@ -588,27 +560,6 @@ begin
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;
var
@ -621,12 +572,10 @@ begin
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
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);
{$pop}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE']; compilerproc;
{

View File

@ -23,15 +23,6 @@
{ some dummy types necessary to have generic resulttypes for certain compilerprocs }
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_normal_set = bitpacked array[0..255] of 0..1;
fpc_normal_set_byte = array[0..31] of byte;
@ -45,11 +36,7 @@ Procedure fpc_freemem(p:pointer);compilerproc;
{$endif FPC_HAS_FEATURE_HEAP}
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;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifndef STR_CONCAT_PROCS}
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_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;
{$endif FPC_STRTOSHORTSTRINGPROC}
function fpc_pchar_length(p:pchar):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;
{$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;
{$endif ndef FPC_STRTOCHARARRAYPROC}
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;
@ -248,11 +223,7 @@ function fpc_AnsiStr_Concat_multi (const sarr:array of Ansistring): ansistring;
{$ifdef EXTRAANSISHORT}
Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString); compilerproc;
{$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;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifdef FPC_HAS_CPSTRING}
Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc;
{$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_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;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : RawByteString): SizeInt; compilerproc;
Function fpc_AnsiStr_Compare_equal(const S1,S2 : RawByteString): SizeInt; compilerproc;
{$ifdef VER2_4}
@ -295,11 +262,7 @@ Function fpc_ansistr_Unique(Var S : Pointer): Pointer; compilerproc;
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_WideStr_Decr_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;
{$endif FPC_STRTOSHORTSTRINGPROC}
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_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_PChar_To_WideStr(const p : pchar): 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_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_equal(const S1,S2 : WideString): SizeInt; compilerproc;
{$ifdef VER2_4}
@ -354,11 +312,7 @@ Function fpc_PWideChar_To_WideStr(const p : pwidechar): widestring; compilerproc
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
Procedure fpc_UnicodeStr_Decr_Ref (Var 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;
{$endif FPC_STRTOSHORTSTRINGPROC}
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_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_PChar_To_UnicodeStr(const p : pchar): 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_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_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;
{$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_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;
{$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_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;
{$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_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;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt; compilerproc;
Function fpc_UnicodeStr_Compare_equal(const S1,S2 : UnicodeString): SizeInt; compilerproc;
{$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_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;
{$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;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif 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}
Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): 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;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$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;
{$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;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

View File

@ -863,19 +863,6 @@ end;
{$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;
var
slen : byte;
@ -886,7 +873,6 @@ begin
move(sstr[0],res[0],slen+1);
res[0]:=chr(slen);
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; {$ifdef HAS_COMPILER_PROC} compilerproc; {$endif}
var
@ -1079,25 +1065,6 @@ end;
{$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;
var
@ -1116,60 +1083,21 @@ begin
res:=s;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$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 }
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}
begin
{$ifndef FPC_STRTOSHORTSTRINGPROC}
result:=fpc_pchar_to_shortstr(p);
{$else FPC_STRTOSHORTSTRINGPROC}
fpc_pchar_to_shortstr(result,p);
{$endif FPC_STRTOSHORTSTRINGPROC}
end;
{$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;
var
l: longint;
@ -1194,34 +1122,12 @@ begin
move(arr[0],res[1],len);
res[0]:=chr(len);
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}
{$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;
var
len: longint;
@ -1237,8 +1143,6 @@ begin
{$pop}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

View File

@ -120,25 +120,13 @@ implementation
{ 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'];
{$endif FPC_STRTOSHORTSTRINGPROC}
function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
{$ifndef FPC_STRTOSHORTSTRINGPROC}
strpas:=fpc_pchar_to_shortstr(p);
{$else FPC_STRTOSHORTSTRINGPROC}
fpc_pchar_to_shortstr(strpas,p);
{$endif FPC_STRTOSHORTSTRINGPROC}
end;
function stralloc(L : SizeInt) : pchar;

View File

@ -243,26 +243,6 @@ Procedure fpc_UnicodeStr_Incr_Ref(S : Pointer);[Public,Alias:'FPC_UNICODESTR_INC
{ alias for internal use }
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;
{
Converts a UnicodeString to a ShortString;
@ -281,7 +261,6 @@ begin
res:=temp;
end;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString;compilerproc;
@ -407,23 +386,6 @@ begin
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;
var
Size : SizeInt;
@ -439,7 +401,6 @@ begin
res:=temp;
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;
@ -461,23 +422,6 @@ begin
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;
var
Size : SizeInt;
@ -493,7 +437,6 @@ begin
res:=temp;
end;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
{ checked against the ansistring routine, 2001-05-27 (FK) }
@ -748,18 +691,6 @@ begin
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;
{
Converts a WideChar to a ShortString;
@ -770,7 +701,6 @@ begin
widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
@ -801,18 +731,6 @@ begin
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;
{
Converts a UnicodeChar to a ShortString;
@ -823,7 +741,6 @@ begin
widestringmanager.Unicode2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_PChar_To_UnicodeStr(const p : pchar): UnicodeString; compilerproc;
@ -862,33 +779,6 @@ begin
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;
var
l: longint;
@ -914,7 +804,6 @@ begin
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp;
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;
var
@ -975,33 +864,6 @@ end;
{ due to their names, the following procedures should be in wstrings.inc,
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;
var
l: longint;
@ -1027,7 +889,6 @@ begin
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp;
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;
var
@ -1067,90 +928,6 @@ begin
Move(arr[0], Pointer(fpc_WideCharArray_To_WideStr)^,i*sizeof(WideChar));
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;
var
@ -1283,7 +1060,6 @@ begin
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_UnicodeStr_Compare(const S1,S2 : UnicodeString): SizeInt;[Public,Alias : 'FPC_UNICODESTR_COMPARE']; compilerproc;
{

View File

@ -179,26 +179,6 @@ Procedure fpc_WideStr_Incr_Ref(Var S : Pointer);[Public,Alias:'FPC_WIDESTR_INCR_
{ alias for internal use }
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;
{
Converts a WideString to a ShortString;
@ -217,7 +197,6 @@ begin
res:=temp;
end;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString;compilerproc;
@ -535,92 +514,6 @@ begin
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;
var
len: SizeInt;
@ -658,7 +551,6 @@ begin
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
{