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

* changed *string_to_*chararray helpers from functions into procedures

Browse Source 
because on win64 the location of a function result can depend on its
    size (so some chararrays had to be returned in registers and others
    by reference, which means it's impossible to have a generic function
    declaration which works in all cases) (mantis #8533)
  * pad constant string assignments to chararrays with #0 up to the
    length of the chararray for 2.0.x compatibility (fixes
    tests/test/tarray3)

git-svn-id: trunk@6915 -
This commit is contained in:
Jonas Maebe 2007-03-18 12:20:01 +00:00
parent 4b252364f8
commit 9cec910eb9
6 changed files with 177 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
compiler/ncnv.pas
View File

@ -778,6 +778,10 @@ implementation
function ttypeconvnode.typecheck_string_to_chararray : tnode;
var
newblock : tblocknode;
newstat : tstatementnode;
restemp : ttempcreatenode;
pchtemp : pchar;
arrsize : aint;
chartype : string[8];
begin
@ -795,7 +799,18 @@ implementation
constant directly. This is handled in ncgcnv }
if (arrsize>=tstringconstnode(left).len) and
is_char(tarraydef(resultdef).elementdef) then
exit;
begin
{ pad the constant string with #0 to the array len }
{ (2.0.x compatible) }
if (arrsize>tstringconstnode(left).len) then
begin
pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len);
left.free;
left:=cstringconstnode.createpchar(pchtemp,arrsize);
typecheckpass(left);
end;
exit;
end;
{ Convert to wide/short/ansistring and call default helper }
if is_widechar(tarraydef(resultdef).elementdef) then
inserttypeconv(left,cwidestringtype)
@ -811,11 +826,16 @@ implementation
chartype:='widechar'
else
chartype:='char';
result := ccallnode.createinternres(
'fpc_'+tstringdef(left.resultdef).stringtypname+
newblock:=internalstatements(newstat);
restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false);
addstatement(newstat,restemp);
addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+
'_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create(
cordconstnode.create(arrsize,s32inttype,true),nil)),resultdef);
left := nil;
ctemprefnode.create(restemp),nil))));
addstatement(newstat,ctempdeletenode.create_normal_temp(restemp));
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
left:=nil;
end;

2
compiler/options.pas
View File

@ -1956,6 +1956,8 @@ begin
def_system_macro('FPC_HAS_VALGRINDBOOL');
def_system_macro('FPC_HAS_STR_CURRENCY');
def_system_macro('FPC_REAL2REAL_FIXED');
def_system_macro('FPC_STRTOCHARARRAYPROC');
{$if defined(x86) or defined(arm)}
def_system_macro('INTERNAL_BACKTRACE');
{$endif}

21
rtl/inc/astrings.inc
View File

@ -409,6 +409,7 @@ begin
Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
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) }
@ -430,7 +431,27 @@ begin
{$endif}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_ansistr_to_chararray(out res: array of char; const src: ansistring); compilerproc;
var
len: SizeInt;
begin
len := length(src);
if len > length(res) then
len := length(res);
{$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],res[0],len);
{ fpc_big_chararray is defined as array[0..0], see compproc.inc why }
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt;[Public,Alias : 'FPC_ANSISTR_COMPARE']; compilerproc;
{

23
rtl/inc/compproc.inc
View File

@ -28,8 +28,10 @@ type
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 = longint;
fpc_normal_set = array[0..7] of longint;
@ -57,7 +59,11 @@ function fpc_pchar_length(p:pchar):longint; compilerproc;
function fpc_pwidechar_length(p:pwidechar):longint; compilerproc;
function fpc_chararray_to_shortstr(const arr: array of char; zerobased: boolean = true):shortstring; compilerproc;
{$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;
@ -176,7 +182,11 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerp
Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; 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 char; const src: ansistring)compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_AnsiStr_Compare(const S1,S2 : AnsiString): SizeInt; compilerproc;
Function fpc_AnsiStr_Compare_equal(const S1,S2 : AnsiString): SizeInt; compilerproc;
Procedure fpc_AnsiStr_CheckZero(p : pointer); compilerproc;
@ -210,13 +220,20 @@ Procedure fpc_WideStr_Concat_multi (Var DestS : Widestring;const sarr:array of W
Function fpc_Char_To_WideStr(const c : WideChar): 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_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
Function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray; compilerproc;
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_ansistr_to_widechararray(arraysize: SizeInt; const src: AnsiString): fpc_big_widechararray; compilerproc;
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; 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_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); compilerproc;
procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased: boolean = true): shortstring; compilerproc;
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt; compilerproc;
Function fpc_WideStr_Compare_equal(const S1,S2 : WideString): SizeInt; compilerproc;
Procedure fpc_WideStr_CheckZero(p : pointer); compilerproc;

23
rtl/inc/generic.inc
View File

@ -760,6 +760,8 @@ end;
{$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;
@ -779,6 +781,27 @@ begin
{$endif}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
var
len: longint;
begin
len := length(src);
if len > length(res) then
len := length(res);
{$r-}
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
move(src[1],res[0],len);
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

86
rtl/inc/wstrings.inc
View File

@ -662,6 +662,8 @@ begin
PWideChar(Pointer(@fpc_WideCharArray_To_WideStr[1])+i*sizeof(WideChar))^:=#0;
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;
@ -748,6 +750,90 @@ begin
{$endif}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
procedure fpc_widestr_to_chararray(out res: array of char; const src: WideString); 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 > length(res) then
len := length(res);
{$r-}
move(temp[1],res[0],len);
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
procedure fpc_widestr_to_widechararray(out res: array of widechar; const src: WideString); compilerproc;
var
len: SizeInt;
begin
len := length(src);
if len > length(res) then
len := length(res);
{$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],res[0],len*SizeOf(WideChar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: AnsiString); 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 > length(res) then
len := length(res);
{$r-}
move(temp[1],res[0],len*sizeof(widechar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); 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 > length(res) then
len := length(res);
{$r-}
move(temp[1],res[0],len*sizeof(widechar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}
Function fpc_WideStr_Compare(const S1,S2 : WideString): SizeInt;[Public,Alias : 'FPC_WIDESTR_COMPARE']; compilerproc;
{
Compares 2 WideStrings;