paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 01:09:06 +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

46
compiler/defcmp.pas
View File

@ -166,7 +166,6 @@ implementation
hct : tconverttype; hct : tconverttype;
hd3 : tobjectdef; hd3 : tobjectdef;
hpd : tprocdef; hpd : tprocdef;
hpe : tenumsym;
begin begin
eq:=te_incompatible; eq:=te_incompatible;
doconv:=tc_not_possible; doconv:=tc_not_possible;
@ -326,30 +325,48 @@ implementation
arraydef : arraydef :
begin begin
{ array of char to string, the length check is done by the firstpass of this node } { array of char to string, the length check is done by the firstpass of this node }
if is_chararray(def_from) or if is_chararray(def_from) or is_open_chararray(def_from) then
(is_char(tarraydef(def_from).elementtype.def) and
is_open_array(def_from)) then
begin begin
doconv:=tc_chararray_2_string; doconv:=tc_chararray_2_string;
if is_open_array(def_from) or if is_open_array(def_from) then
(is_shortstring(def_to) and begin
(def_from.size <= 255)) or if is_ansistring(def_to) then
(is_ansistring(def_to) and eq:=te_convert_l1
(def_from.size > 255)) then 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 eq:=te_convert_l1
else else
eq:=te_convert_l2; eq:=te_convert_l2;
end end
else
eq:=te_convert_l2;
end;
end
else else
{ array of widechar to string, the length check is done by the firstpass of this node } { array of widechar to string, the length check is done by the firstpass of this node }
if is_widechararray(def_from) or if is_widechararray(def_from) or is_open_widechararray(def_from) then
(is_widechar(tarraydef(def_from).elementtype.def) and
is_open_array(def_from)) then
begin begin
doconv:=tc_chararray_2_string; doconv:=tc_chararray_2_string;
if is_widestring(def_to) then if is_widestring(def_to) then
eq:=te_convert_l1 eq:=te_convert_l1
else else
{ 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; eq:=te_convert_l3;
end; end;
end; end;
@ -1349,7 +1366,10 @@ implementation
end. end.
{ {
$Log$ $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 + compiler side of variant<->interface implemented
Revision 1.64 2005/01/06 13:30:40 florian 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 } {# Returns true if p is a wide char array def }
function is_widechararray(p : tdef) : boolean; 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 String helper functions
*****************************************************************************} *****************************************************************************}
@ -565,6 +571,20 @@ implementation
end; 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 } { true if p is a pchar def }
function is_pchar(p : tdef) : boolean; function is_pchar(p : tdef) : boolean;
begin begin
@ -888,7 +908,10 @@ implementation
end. end.
{ {
$Log$ $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 * support > 32bit accesses for x86_64
* rewrote array size checking to support 64bit * rewrote array size checking to support 64bit

16
compiler/htypechk.pas
View File

@ -230,13 +230,15 @@ implementation
end; end;
{ not chararray+[(wide)char,(wide)string,(wide)chararray] } { not chararray+[(wide)char,(wide)string,(wide)chararray] }
if (is_chararray(ld) or is_widechararray(ld) or 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))) is_open_chararray(ld) or is_open_widechararray(ld))
) and and
((rd.deftype in [stringdef,orddef,enumdef]) or ((rd.deftype in [stringdef,orddef,enumdef]) or
is_pchar(rd) or is_pchar(rd) or
is_pwidechar(rd) or is_pwidechar(rd) or
is_chararray(rd) or is_chararray(rd) or
is_widechararray(rd) or is_widechararray(rd) or
is_open_chararray(rd) or
is_open_widechararray(rd) or
(rt=niln)) then (rt=niln)) then
begin begin
allowed:=false; allowed:=false;
@ -267,12 +269,13 @@ implementation
end; end;
stringdef : stringdef :
begin begin
if ((rd.deftype in [orddef,enumdef,stringdef]) or if (rd.deftype in [orddef,enumdef,stringdef]) or
is_pchar(rd) or is_pchar(rd) or
is_pwidechar(rd) or is_pwidechar(rd) or
is_chararray(rd) or is_chararray(rd) or
is_widechararray(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 is_open_chararray(rd) or
is_open_widechararray(rd) then
begin begin
allowed:=false; allowed:=false;
exit; exit;
@ -1974,7 +1977,10 @@ implementation
end. end.
{ {
$Log$ $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 * handle string-open array of (wide)char without variants
Revision 1.106 2004/12/05 12:28:10 peter Revision 1.106 2004/12/05 12:28:10 peter

86
compiler/nadd.pas
View File

@ -114,6 +114,7 @@ implementation
rv,lv : tconstexprint; rv,lv : tconstexprint;
rvd,lvd : bestreal; rvd,lvd : bestreal;
resultrealtype : ttype; resultrealtype : ttype;
strtype: tstringtype;
{$ifdef state_tracking} {$ifdef state_tracking}
factval : Tnode; factval : Tnode;
change : boolean; change : boolean;
@ -1061,60 +1062,67 @@ implementation
care of chararray+chararray and chararray+char. care of chararray+chararray and chararray+char.
Note: Must be done after pointerdef+pointerdef has been checked, else Note: Must be done after pointerdef+pointerdef has been checked, else
pchar is converted to string } pchar is converted to string }
else if (rd.deftype=stringdef) or (ld.deftype=stringdef) or else if (rd.deftype=stringdef) or
((is_pchar(rd) or is_chararray(rd) or is_char(rd)) and (ld.deftype=stringdef) or
(is_pchar(ld) or is_chararray(ld) or is_char(ld))) then ((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 begin
if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then
begin begin
if is_widestring(rd) or is_widestring(ld) then { 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
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 begin
if not(is_widestring(rd)) then if not(is_widestring(rd)) then
inserttypeconv(right,cwidestringtype); inserttypeconv(right,cwidestringtype);
if not(is_widestring(ld)) then if not(is_widestring(ld)) then
inserttypeconv(left,cwidestringtype); inserttypeconv(left,cwidestringtype);
end end;
else if is_ansistring(rd) or is_ansistring(ld) then st_ansistring :
begin begin
if not(is_ansistring(rd)) then 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); inserttypeconv(right,cansistringtype);
{$endif}
end;
if not(is_ansistring(ld)) then 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); inserttypeconv(left,cansistringtype);
{$endif}
end; end;
end st_longstring :
else if is_longstring(rd) or is_longstring(ld) then
begin begin
if not(is_longstring(rd)) then if not(is_longstring(rd)) then
inserttypeconv(right,clongstringtype); inserttypeconv(right,clongstringtype);
if not(is_longstring(ld)) then if not(is_longstring(ld)) then
inserttypeconv(left,clongstringtype); inserttypeconv(left,clongstringtype);
end end;
else st_shortstring :
begin begin
if not(is_shortstring(ld)) then if not(is_shortstring(ld)) then
inserttypeconv(left,cshortstringtype); inserttypeconv(left,cshortstringtype);
@ -1122,6 +1130,9 @@ implementation
if not(is_shortstring(rd) or is_char(rd)) then if not(is_shortstring(rd) or is_char(rd)) then
inserttypeconv(right,cshortstringtype); inserttypeconv(right,cshortstringtype);
end; end;
else
internalerror(2005101);
end;
end end
else else
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
@ -2058,7 +2069,10 @@ begin
end. end.
{ {
$Log$ $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. unsigned*unsigned will also have unsigned result.
Revision 1.132 2004/12/06 15:57:22 peter Revision 1.132 2004/12/06 15:57:22 peter