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

* widestring patches from Alexey Barkovoy

Browse Source
This commit is contained in:
peter 2005-01-10 22:10:26 +00:00
parent a26f092c5d
commit 8f8e6f6809
4 changed files with 149 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
compiler/defcmp.pas
View File

@ -166,7 +166,6 @@ implementation
hct : tconverttype;
hd3 : tobjectdef;
hpd : tprocdef;
hpe : tenumsym;
begin
eq:=te_incompatible;
doconv:=tc_not_possible;
@ -326,31 +325,49 @@ implementation
arraydef :
begin
{ array of char to string, the length check is done by the firstpass of this node }
if is_chararray(def_from) or
(is_char(tarraydef(def_from).elementtype.def) and
is_open_array(def_from)) then
if is_chararray(def_from) or is_open_chararray(def_from) then
begin
doconv:=tc_chararray_2_string;
if is_open_array(def_from) or
(is_shortstring(def_to) and
(def_from.size <= 255)) or
(is_ansistring(def_to) and
(def_from.size > 255)) then
eq:=te_convert_l1
else
eq:=te_convert_l2;
if is_open_array(def_from) then
begin
if is_ansistring(def_to) then
eq:=te_convert_l1
else if is_widestring(def_to) then
eq:=te_convert_l2
else
eq:=te_convert_l2;
end
else
begin
if is_shortstring(def_to) then
begin
{ Only compatible with arrays that fit
smaller than 255 chars }
if (def_from.size <= 255) then
eq:=te_convert_l1;
end
else if is_ansistring(def_to) then
begin
if (def_from.size > 255) then
eq:=te_convert_l1
else
eq:=te_convert_l2;
end
else
eq:=te_convert_l2;
end;
end
else
{ array of widechar to string, the length check is done by the firstpass of this node }
if is_widechararray(def_from) or
(is_widechar(tarraydef(def_from).elementtype.def) and
is_open_array(def_from)) then
if is_widechararray(def_from) or is_open_widechararray(def_from) then
begin
doconv:=tc_chararray_2_string;
if is_widestring(def_to) then
eq:=te_convert_l1
eq:=te_convert_l1
else
eq:=te_convert_l3;
{ size of widechar array is double due the sizeof a widechar }
if not(is_shortstring(def_to) and (def_from.size>255*sizeof(widechar))) then
eq:=te_convert_l3;
end;
end;
pointerdef :
@ -1349,7 +1366,10 @@ implementation
end.
{
$Log$
Revision 1.65 2005-01-07 21:14:21 florian
Revision 1.66 2005-01-10 22:10:26 peter
* widestring patches from Alexey Barkovoy
Revision 1.65 2005/01/07 21:14:21 florian
+ compiler side of variant<->interface implemented
Revision 1.64 2005/01/06 13:30:40 florian

25
compiler/defutil.pas
View File

@ -127,6 +127,12 @@ interface
{# Returns true if p is a wide char array def }
function is_widechararray(p : tdef) : boolean;
{# Returns true if p is a open char array def }
function is_open_chararray(p : tdef) : boolean;
{# Returns true if p is a open wide char array def }
function is_open_widechararray(p : tdef) : boolean;
{*****************************************************************************
String helper functions
*****************************************************************************}
@ -565,6 +571,20 @@ implementation
end;
{ true if p is a open char array def }
function is_open_chararray(p : tdef) : boolean;
begin
is_open_chararray:= is_open_array(p) and
is_char(tarraydef(p).elementtype.def);
end;
{ true if p is a open wide char array def }
function is_open_widechararray(p : tdef) : boolean;
begin
is_open_widechararray:= is_open_array(p) and
is_widechar(tarraydef(p).elementtype.def);
end;
{ true if p is a pchar def }
function is_pchar(p : tdef) : boolean;
begin
@ -888,7 +908,10 @@ implementation
end.
{
$Log$
Revision 1.21 2004-11-01 23:30:11 peter
Revision 1.22 2005-01-10 22:10:26 peter
* widestring patches from Alexey Barkovoy
Revision 1.21 2004/11/01 23:30:11 peter
* support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit

24
compiler/htypechk.pas
View File

@ -230,13 +230,15 @@ implementation
end;
{ not chararray+[(wide)char,(wide)string,(wide)chararray] }
if (is_chararray(ld) or is_widechararray(ld) or
(is_open_array(ld) and (is_char(tarraydef(ld).elementtype.def) or is_widechar(tarraydef(ld).elementtype.def)))
) and
is_open_chararray(ld) or is_open_widechararray(ld))
and
((rd.deftype in [stringdef,orddef,enumdef]) or
is_pchar(rd) or
is_pwidechar(rd) or
is_chararray(rd) or
is_widechararray(rd) or
is_open_chararray(rd) or
is_open_widechararray(rd) or
(rt=niln)) then
begin
allowed:=false;
@ -267,12 +269,13 @@ implementation
end;
stringdef :
begin
if ((rd.deftype in [orddef,enumdef,stringdef]) or
is_pchar(rd) or
is_pwidechar(rd) or
is_chararray(rd) or
is_widechararray(rd) or
(is_open_array(rd) and (is_char(tarraydef(rd).elementtype.def) or is_widechar(tarraydef(rd).elementtype.def)))) then
if (rd.deftype in [orddef,enumdef,stringdef]) or
is_pchar(rd) or
is_pwidechar(rd) or
is_chararray(rd) or
is_widechararray(rd) or
is_open_chararray(rd) or
is_open_widechararray(rd) then
begin
allowed:=false;
exit;
@ -1974,7 +1977,10 @@ implementation
end.
{
$Log$
Revision 1.107 2005-01-07 16:22:47 peter
Revision 1.108 2005-01-10 22:10:26 peter
* widestring patches from Alexey Barkovoy
Revision 1.107 2005/01/07 16:22:47 peter
* handle string-open array of (wide)char without variants
Revision 1.106 2004/12/05 12:28:10 peter

130
compiler/nadd.pas
View File

@ -114,6 +114,7 @@ implementation
rv,lv : tconstexprint;
rvd,lvd : bestreal;
resultrealtype : ttype;
strtype: tstringtype;
{$ifdef state_tracking}
factval : Tnode;
change : boolean;
@ -1061,67 +1062,77 @@ implementation
care of chararray+chararray and chararray+char.
Note: Must be done after pointerdef+pointerdef has been checked, else
pchar is converted to string }
else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or
((is_pchar(rd) or is_chararray(rd) or is_char(rd)) and
(is_pchar(ld) or is_chararray(ld) or is_char(ld))) then
else if (rd.deftype=stringdef) or
(ld.deftype=stringdef) or
((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or
is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and
(is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or
is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then
begin
if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
begin
if is_widestring(rd) or is_widestring(ld) then
begin
if not(is_widestring(rd)) then
inserttypeconv(right,cwidestringtype);
if not(is_widestring(ld)) then
inserttypeconv(left,cwidestringtype);
end
else if is_ansistring(rd) or is_ansistring(ld) then
begin
if not(is_ansistring(rd)) then
begin
{$ifdef ansistring_bits}
case Tstringdef(ld).string_typ of
st_ansistring16:
inserttypeconv(right,cansistringtype16);
st_ansistring32:
inserttypeconv(right,cansistringtype32);
st_ansistring64:
inserttypeconv(right,cansistringtype64);
end;
{$else}
inserttypeconv(right,cansistringtype);
{$endif}
end;
if not(is_ansistring(ld)) then
begin
{$ifdef ansistring_bits}
case Tstringdef(rd).string_typ of
st_ansistring16:
inserttypeconv(left,cansistringtype16);
st_ansistring32:
inserttypeconv(left,cansistringtype32);
st_ansistring64:
inserttypeconv(left,cansistringtype64);
end;
{$else}
inserttypeconv(left,cansistringtype);
{$endif}
end;
end
else if is_longstring(rd) or is_longstring(ld) then
begin
if not(is_longstring(rd)) then
inserttypeconv(right,clongstringtype);
if not(is_longstring(ld)) then
inserttypeconv(left,clongstringtype);
end
{ Is there a widestring? }
if is_widestring(rd) or is_widestring(ld) or
is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or
is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then
strtype:= st_widestring
else
begin
if not(is_shortstring(ld)) then
inserttypeconv(left,cshortstringtype);
{ don't convert char, that can be handled by the optimized node }
if not(is_shortstring(rd) or is_char(rd)) then
inserttypeconv(right,cshortstringtype);
end;
if is_ansistring(rd) or is_ansistring(ld) or
((cs_ansistrings in aktlocalswitches) and
//todo: Move some of this to longstring's then they are implemented?
(
is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or
is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld)
)
) then
strtype:= st_ansistring
else
if is_longstring(rd) or is_longstring(ld) then
strtype:= st_longstring
else
begin
{$warning todo: add a warning/hint here if one converting a too large array}
{ nodes is PChar, array [with size > 255] or OpenArrayOfChar.
Note: Delphi halts with error if "array [0..xx] of char"
is assigned to ShortString and string length is less
then array size }
strtype:= st_shortstring;
end;
// Now convert nodes to common string type
case strtype of
st_widestring :
begin
if not(is_widestring(rd)) then
inserttypeconv(right,cwidestringtype);
if not(is_widestring(ld)) then
inserttypeconv(left,cwidestringtype);
end;
st_ansistring :
begin
if not(is_ansistring(rd)) then
inserttypeconv(right,cansistringtype);
if not(is_ansistring(ld)) then
inserttypeconv(left,cansistringtype);
end;
st_longstring :
begin
if not(is_longstring(rd)) then
inserttypeconv(right,clongstringtype);
if not(is_longstring(ld)) then
inserttypeconv(left,clongstringtype);
end;
st_shortstring :
begin
if not(is_shortstring(ld)) then
inserttypeconv(left,cshortstringtype);
{ don't convert char, that can be handled by the optimized node }
if not(is_shortstring(rd) or is_char(rd)) then
inserttypeconv(right,cshortstringtype);
end;
else
internalerror(2005101);
end;
end
else
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
@ -2058,7 +2069,10 @@ begin
end.
{
$Log$
Revision 1.133 2005-01-02 17:31:07 peter
Revision 1.134 2005-01-10 22:10:26 peter
* widestring patches from Alexey Barkovoy
Revision 1.133 2005/01/02 17:31:07 peter
unsigned*unsigned will also have unsigned result.
Revision 1.132 2004/12/06 15:57:22 peter