mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-09 04:45:58 +02:00
+ subrange types for enums
+ checking for bounds type with ranges
This commit is contained in:
peter
parent
3c3276a915
commit
35c6030a1b
@ -159,7 +159,7 @@ unit pass_1;
|
|||||||
|
|
||||||
{ Only when the difference between the left and right registers < the
|
{ Only when the difference between the left and right registers < the
|
||||||
wanted registers allocate the amount of registers }
|
wanted registers allocate the amount of registers }
|
||||||
|
|
||||||
if assigned(p^.left) then
|
if assigned(p^.left) then
|
||||||
begin
|
begin
|
||||||
if assigned(p^.right) then
|
if assigned(p^.right) then
|
||||||
@ -275,7 +275,7 @@ unit pass_1;
|
|||||||
|
|
||||||
var
|
var
|
||||||
b : boolean;
|
b : boolean;
|
||||||
|
hd1,hd2 : pdef;
|
||||||
begin
|
begin
|
||||||
b:=false;
|
b:=false;
|
||||||
if (not assigned(def_from)) or (not assigned(def_to)) then
|
if (not assigned(def_from)) or (not assigned(def_to)) then
|
||||||
@ -284,13 +284,16 @@ unit pass_1;
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ handle ord to ord first }
|
||||||
if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
|
if (def_from^.deftype=orddef) and (def_to^.deftype=orddef) then
|
||||||
begin
|
begin
|
||||||
doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
|
doconv:=basedefconverts[porddef(def_from)^.typ,porddef(def_to)^.typ];
|
||||||
if doconv<>tc_not_possible then
|
if doconv<>tc_not_possible then
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else if (def_from^.deftype=orddef) and (def_to^.deftype=floatdef) then
|
else
|
||||||
|
|
||||||
|
if (def_from^.deftype=orddef) and (def_to^.deftype=floatdef) then
|
||||||
begin
|
begin
|
||||||
if pfloatdef(def_to)^.typ=f32bit then
|
if pfloatdef(def_to)^.typ=f32bit then
|
||||||
doconv:=tc_int_2_fix
|
doconv:=tc_int_2_fix
|
||||||
@ -298,7 +301,10 @@ unit pass_1;
|
|||||||
doconv:=tc_int_2_real;
|
doconv:=tc_int_2_real;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else if (def_from^.deftype=floatdef) and (def_to^.deftype=floatdef) then
|
else
|
||||||
|
|
||||||
|
{ 2 float types ? }
|
||||||
|
if (def_from^.deftype=floatdef) and (def_to^.deftype=floatdef) then
|
||||||
begin
|
begin
|
||||||
if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
|
if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
|
||||||
doconv:=tc_equal
|
doconv:=tc_equal
|
||||||
@ -320,25 +326,46 @@ unit pass_1;
|
|||||||
end;
|
end;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
{ enum to enum }
|
||||||
|
if (def_from^.deftype=enumdef) and (def_to^.deftype=enumdef) then
|
||||||
|
begin
|
||||||
|
if assigned(penumdef(def_from)^.basedef) then
|
||||||
|
hd1:=penumdef(def_from)^.basedef
|
||||||
|
else
|
||||||
|
hd1:=def_from;
|
||||||
|
if assigned(penumdef(def_to)^.basedef) then
|
||||||
|
hd2:=penumdef(def_to)^.basedef
|
||||||
|
else
|
||||||
|
hd2:=def_to;
|
||||||
|
b:=(hd1=hd2);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ assignment overwritten ?? }
|
{ assignment overwritten ?? }
|
||||||
else if is_assignment_overloaded(def_from,def_to) then
|
if is_assignment_overloaded(def_from,def_to) then
|
||||||
b:=true
|
b:=true
|
||||||
else if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and
|
else
|
||||||
(parraydef(def_to)^.lowrange=0) and
|
|
||||||
is_equal(ppointerdef(def_from)^.definition,
|
if (def_from^.deftype=pointerdef) and (def_to^.deftype=arraydef) and
|
||||||
parraydef(def_to)^.definition) then
|
(parraydef(def_to)^.lowrange=0) and
|
||||||
|
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_pointer_to_array;
|
doconv:=tc_pointer_to_array;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else if (def_from^.deftype=arraydef) and (def_to^.deftype=pointerdef) and
|
else
|
||||||
(parraydef(def_from)^.lowrange=0) and
|
|
||||||
is_equal(parraydef(def_from)^.definition,
|
if (def_from^.deftype=arraydef) and (def_to^.deftype=pointerdef) and
|
||||||
ppointerdef(def_to)^.definition) then
|
(parraydef(def_from)^.lowrange=0) and
|
||||||
|
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_array_to_pointer;
|
doconv:=tc_array_to_pointer;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ typed files are all equal to the abstract file type
|
{ typed files are all equal to the abstract file type
|
||||||
name TYPEDFILE in system.pp in is_equal in types.pas
|
name TYPEDFILE in system.pp in is_equal in types.pas
|
||||||
the problem is that it sholud be also compatible to FILE
|
the problem is that it sholud be also compatible to FILE
|
||||||
@ -346,7 +373,7 @@ unit pass_1;
|
|||||||
when trying to find the good overloaded function !!
|
when trying to find the good overloaded function !!
|
||||||
so all file function are doubled in system.pp
|
so all file function are doubled in system.pp
|
||||||
this is not very beautiful !!}
|
this is not very beautiful !!}
|
||||||
else if (def_from^.deftype=filedef) and (def_to^.deftype=filedef) and
|
if (def_from^.deftype=filedef) and (def_to^.deftype=filedef) and
|
||||||
(
|
(
|
||||||
(
|
(
|
||||||
(pfiledef(def_from)^.filetype = ft_typed) and
|
(pfiledef(def_from)^.filetype = ft_typed) and
|
||||||
@ -371,23 +398,28 @@ unit pass_1;
|
|||||||
doconv:=tc_equal;
|
doconv:=tc_equal;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ object pascal objects }
|
{ object pascal objects }
|
||||||
else if (def_from^.deftype=objectdef) and (def_to^.deftype=objectdef) {and
|
if (def_from^.deftype=objectdef) and (def_to^.deftype=objectdef) {and
|
||||||
pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
|
pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_equal;
|
doconv:=tc_equal;
|
||||||
b:=pobjectdef(def_from)^.isrelated(
|
b:=pobjectdef(def_from)^.isrelated(
|
||||||
pobjectdef(def_to));
|
pobjectdef(def_to));
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ class reference types }
|
{ class reference types }
|
||||||
else if (def_from^.deftype=classrefdef) and (def_from^.deftype=classrefdef) then
|
if (def_from^.deftype=classrefdef) and (def_from^.deftype=classrefdef) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_equal;
|
doconv:=tc_equal;
|
||||||
b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
|
b:=pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
|
||||||
pobjectdef(pclassrefdef(def_to)^.definition));
|
pobjectdef(pclassrefdef(def_to)^.definition));
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
else if (def_from^.deftype=pointerdef) and (def_to^.deftype=pointerdef) then
|
if (def_from^.deftype=pointerdef) and (def_to^.deftype=pointerdef) then
|
||||||
begin
|
begin
|
||||||
{ child class pointer can be assigned to anchestor pointers }
|
{ child class pointer can be assigned to anchestor pointers }
|
||||||
if (
|
if (
|
||||||
@ -405,57 +437,51 @@ unit pass_1;
|
|||||||
doconv:=tc_equal;
|
doconv:=tc_equal;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
if (def_from^.deftype=stringdef) and (def_to^.deftype=stringdef) then
|
|
||||||
begin
|
if (def_from^.deftype=stringdef) and (def_to^.deftype=stringdef) then
|
||||||
doconv:=tc_string_to_string;
|
begin
|
||||||
b:=true;
|
doconv:=tc_string_to_string;
|
||||||
end
|
b:=true;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
{ char to string}
|
|
||||||
if is_equal(def_from,cchardef) and
|
{ char to string}
|
||||||
(def_to^.deftype=stringdef) then
|
if is_equal(def_from,cchardef) and (def_to^.deftype=stringdef) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_char_to_string;
|
doconv:=tc_char_to_string;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
{ string constant to zero terminated string constant }
|
|
||||||
if (fromtreetype=stringconstn) and
|
{ string constant to zero terminated string constant }
|
||||||
(
|
if (fromtreetype=stringconstn) and
|
||||||
(def_to^.deftype=pointerdef) and
|
((def_to^.deftype=pointerdef) and is_equal(Ppointerdef(def_to)^.definition,cchardef)) then
|
||||||
is_equal(Ppointerdef(def_to)^.definition,cchardef)
|
begin
|
||||||
) then
|
doconv:=tc_cstring_charpointer;
|
||||||
begin
|
b:=true;
|
||||||
doconv:=tc_cstring_charpointer;
|
end
|
||||||
b:=true;
|
|
||||||
end
|
|
||||||
else
|
else
|
||||||
{ 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 (def_from^.deftype=stringdef) and
|
if (def_from^.deftype=stringdef) and
|
||||||
(
|
((def_to^.deftype=arraydef) and is_equal(parraydef(def_to)^.definition,cchardef)) then
|
||||||
(def_to^.deftype=arraydef) and
|
begin
|
||||||
is_equal(parraydef(def_to)^.definition,cchardef)
|
doconv:=tc_string_chararray;
|
||||||
) then
|
b:=true;
|
||||||
begin
|
end
|
||||||
doconv:=tc_string_chararray;
|
|
||||||
b:=true;
|
|
||||||
end
|
|
||||||
else
|
else
|
||||||
{ string to array of char }
|
|
||||||
{ the length check is done by the firstpass of this node }
|
{ string to array of char, the length check is done by the firstpass of this node }
|
||||||
if (
|
if ((def_from^.deftype=arraydef) and is_equal(parraydef(def_from)^.definition,cchardef)) and
|
||||||
(def_from^.deftype=arraydef) and
|
|
||||||
is_equal(parraydef(def_from)^.definition,cchardef)
|
|
||||||
) and
|
|
||||||
(def_to^.deftype=stringdef) then
|
(def_to^.deftype=stringdef) then
|
||||||
begin
|
begin
|
||||||
doconv:=tc_chararray_2_string;
|
doconv:=tc_chararray_2_string;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) then
|
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) then
|
||||||
begin
|
begin
|
||||||
if (def_to^.deftype=pointerdef) and
|
if (def_to^.deftype=pointerdef) and
|
||||||
@ -466,6 +492,7 @@ unit pass_1;
|
|||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
if (def_to^.deftype=procvardef) and (def_from^.deftype=procdef) then
|
if (def_to^.deftype=procvardef) and (def_from^.deftype=procdef) then
|
||||||
begin
|
begin
|
||||||
def_from^.deftype:=procvardef;
|
def_from^.deftype:=procvardef;
|
||||||
@ -474,6 +501,7 @@ unit pass_1;
|
|||||||
def_from^.deftype:=procdef;
|
def_from^.deftype:=procdef;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
{ nil is compatible with class instances }
|
{ nil is compatible with class instances }
|
||||||
if (fromtreetype=niln) and (def_to^.deftype=objectdef)
|
if (fromtreetype=niln) and (def_to^.deftype=objectdef)
|
||||||
and (pobjectdef(def_to)^.isclass) then
|
and (pobjectdef(def_to)^.isclass) then
|
||||||
@ -482,6 +510,7 @@ unit pass_1;
|
|||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
{ nil is compatible with class references }
|
{ nil is compatible with class references }
|
||||||
if (fromtreetype=niln) and (def_to^.deftype=classrefdef) then
|
if (fromtreetype=niln) and (def_to^.deftype=classrefdef) then
|
||||||
begin
|
begin
|
||||||
@ -489,6 +518,7 @@ unit pass_1;
|
|||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
{ nil is compatible with procvars }
|
{ nil is compatible with procvars }
|
||||||
if (fromtreetype=niln) and (def_to^.deftype=procvardef) then
|
if (fromtreetype=niln) and (def_to^.deftype=procvardef) then
|
||||||
begin
|
begin
|
||||||
@ -496,6 +526,7 @@ unit pass_1;
|
|||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
{ nil is compatible with ansi- and wide strings }
|
{ nil is compatible with ansi- and wide strings }
|
||||||
if (fromtreetype=niln) and (def_to^.deftype=stringdef)
|
if (fromtreetype=niln) and (def_to^.deftype=stringdef)
|
||||||
and (pstringdef(def_to)^.string_typ in [st_ansistring,st_widestring]) then
|
and (pstringdef(def_to)^.string_typ in [st_ansistring,st_widestring]) then
|
||||||
@ -504,6 +535,7 @@ unit pass_1;
|
|||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
{ ansi- and wide strings can be assigned to void pointers }
|
{ ansi- and wide strings can be assigned to void pointers }
|
||||||
if (def_from^.deftype=stringdef) and
|
if (def_from^.deftype=stringdef) and
|
||||||
(pstringdef(def_from)^.string_typ in [st_ansistring,st_widestring]) and
|
(pstringdef(def_from)^.string_typ in [st_ansistring,st_widestring]) and
|
||||||
@ -514,9 +546,10 @@ unit pass_1;
|
|||||||
doconv:=tc_equal;
|
doconv:=tc_equal;
|
||||||
b:=true;
|
b:=true;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ procedure variable can be assigned to an void pointer }
|
{ procedure variable can be assigned to an void pointer }
|
||||||
{ Not anymore. Use the @ operator now.}
|
{ Not anymore. Use the @ operator now.}
|
||||||
else
|
|
||||||
if not (cs_tp_compatible in aktmoduleswitches) then
|
if not (cs_tp_compatible in aktmoduleswitches) then
|
||||||
begin
|
begin
|
||||||
if (def_from^.deftype=procvardef) and
|
if (def_from^.deftype=procvardef) and
|
||||||
@ -528,9 +561,11 @@ unit pass_1;
|
|||||||
b:=true;
|
b:=true;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
isconvertable:=b;
|
isconvertable:=b;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure firsterror(var p : ptree);
|
procedure firsterror(var p : ptree);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -687,6 +722,7 @@ unit pass_1;
|
|||||||
resultset : pconstset;
|
resultset : pconstset;
|
||||||
i : longint;
|
i : longint;
|
||||||
b : boolean;
|
b : boolean;
|
||||||
|
convdone : boolean;
|
||||||
{$ifndef UseAnsiString}
|
{$ifndef UseAnsiString}
|
||||||
s1,s2:^string;
|
s1,s2:^string;
|
||||||
{$else UseAnsiString}
|
{$else UseAnsiString}
|
||||||
@ -706,6 +742,7 @@ unit pass_1;
|
|||||||
rt:=p^.right^.treetype;
|
rt:=p^.right^.treetype;
|
||||||
rd:=p^.right^.resulttype;
|
rd:=p^.right^.resulttype;
|
||||||
ld:=p^.left^.resulttype;
|
ld:=p^.left^.resulttype;
|
||||||
|
convdone:=false;
|
||||||
|
|
||||||
if codegenerror then
|
if codegenerror then
|
||||||
exit;
|
exit;
|
||||||
@ -771,16 +808,14 @@ unit pass_1;
|
|||||||
|
|
||||||
{ convert int consts to real consts, if the }
|
{ convert int consts to real consts, if the }
|
||||||
{ other operand is a real const }
|
{ other operand is a real const }
|
||||||
if is_constintnode(p^.left) and
|
if (rt=realconstn) and is_constintnode(p^.left) then
|
||||||
(rt=realconstn) then
|
|
||||||
begin
|
begin
|
||||||
t:=genrealconstnode(p^.left^.value);
|
t:=genrealconstnode(p^.left^.value);
|
||||||
disposetree(p^.left);
|
disposetree(p^.left);
|
||||||
p^.left:=t;
|
p^.left:=t;
|
||||||
lt:=realconstn;
|
lt:=realconstn;
|
||||||
end;
|
end;
|
||||||
if is_constintnode(p^.right) and
|
if (lt=realconstn) and is_constintnode(p^.right) then
|
||||||
(lt=realconstn) then
|
|
||||||
begin
|
begin
|
||||||
t:=genrealconstnode(p^.right^.value);
|
t:=genrealconstnode(p^.right^.value);
|
||||||
disposetree(p^.right);
|
disposetree(p^.right);
|
||||||
@ -788,87 +823,65 @@ unit pass_1;
|
|||||||
rt:=realconstn;
|
rt:=realconstn;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if is_constintnode(p^.left) and
|
{ both are int constants ? }
|
||||||
is_constintnode(p^.right) then
|
if is_constintnode(p^.left) and is_constintnode(p^.right) then
|
||||||
begin
|
begin
|
||||||
lv:=p^.left^.value;
|
lv:=p^.left^.value;
|
||||||
rv:=p^.right^.value;
|
rv:=p^.right^.value;
|
||||||
case p^.treetype of
|
case p^.treetype of
|
||||||
addn:
|
addn : t:=genordinalconstnode(lv+rv,s32bitdef);
|
||||||
t:=genordinalconstnode(lv+rv,s32bitdef);
|
subn : t:=genordinalconstnode(lv-rv,s32bitdef);
|
||||||
subn:
|
muln : t:=genordinalconstnode(lv*rv,s32bitdef);
|
||||||
t:=genordinalconstnode(lv-rv,s32bitdef);
|
xorn : t:=genordinalconstnode(lv xor rv,s32bitdef);
|
||||||
muln:
|
orn : t:=genordinalconstnode(lv or rv,s32bitdef);
|
||||||
t:=genordinalconstnode(lv*rv,s32bitdef);
|
andn : t:=genordinalconstnode(lv and rv,s32bitdef);
|
||||||
xorn:
|
ltn : t:=genordinalconstnode(ord(lv<rv),booldef);
|
||||||
t:=genordinalconstnode(lv xor rv,s32bitdef);
|
lten : t:=genordinalconstnode(ord(lv<=rv),booldef);
|
||||||
orn:
|
gtn : t:=genordinalconstnode(ord(lv>rv),booldef);
|
||||||
t:=genordinalconstnode(lv or rv,s32bitdef);
|
gten : t:=genordinalconstnode(ord(lv>=rv),booldef);
|
||||||
andn:
|
equaln : t:=genordinalconstnode(ord(lv=rv),booldef);
|
||||||
t:=genordinalconstnode(lv and rv,s32bitdef);
|
unequaln : t:=genordinalconstnode(ord(lv<>rv),booldef);
|
||||||
ltn:
|
slashn : begin
|
||||||
t:=genordinalconstnode(ord(lv<rv),booldef);
|
{ int/int becomes a real }
|
||||||
lten:
|
t:=genrealconstnode(int(lv)/int(rv));
|
||||||
t:=genordinalconstnode(ord(lv<=rv),booldef);
|
firstpass(t);
|
||||||
gtn:
|
end;
|
||||||
t:=genordinalconstnode(ord(lv>rv),booldef);
|
else
|
||||||
gten:
|
Message(sym_e_type_mismatch);
|
||||||
t:=genordinalconstnode(ord(lv>=rv),booldef);
|
end;
|
||||||
equaln:
|
|
||||||
t:=genordinalconstnode(ord(lv=rv),booldef);
|
|
||||||
unequaln:
|
|
||||||
t:=genordinalconstnode(ord(lv<>rv),booldef);
|
|
||||||
slashn :
|
|
||||||
begin
|
|
||||||
{ int/int becomes a real }
|
|
||||||
t:=genrealconstnode(int(lv)/int(rv));
|
|
||||||
firstpass(t);
|
|
||||||
end;
|
|
||||||
else
|
|
||||||
Message(sym_e_type_mismatch);
|
|
||||||
end;
|
|
||||||
disposetree(p);
|
disposetree(p);
|
||||||
firstpass(t);
|
firstpass(t);
|
||||||
p:=t;
|
p:=t;
|
||||||
exit;
|
exit;
|
||||||
end
|
end;
|
||||||
else
|
|
||||||
{ real constants }
|
{ both real constants ? }
|
||||||
if (lt=realconstn) and (rt=realconstn) then
|
if (lt=realconstn) and (rt=realconstn) then
|
||||||
begin
|
begin
|
||||||
lvd:=p^.left^.valued;
|
lvd:=p^.left^.valued;
|
||||||
rvd:=p^.right^.valued;
|
rvd:=p^.right^.valued;
|
||||||
case p^.treetype of
|
case p^.treetype of
|
||||||
addn:
|
addn : t:=genrealconstnode(lvd+rvd);
|
||||||
t:=genrealconstnode(lvd+rvd);
|
subn : t:=genrealconstnode(lvd-rvd);
|
||||||
subn:
|
muln : t:=genrealconstnode(lvd*rvd);
|
||||||
t:=genrealconstnode(lvd-rvd);
|
caretn : t:=genrealconstnode(exp(ln(lvd)*rvd));
|
||||||
muln:
|
slashn : t:=genrealconstnode(lvd/rvd);
|
||||||
t:=genrealconstnode(lvd*rvd);
|
ltn : t:=genordinalconstnode(ord(lvd<rvd),booldef);
|
||||||
caretn:
|
lten : t:=genordinalconstnode(ord(lvd<=rvd),booldef);
|
||||||
t:=genrealconstnode(exp(ln(lvd)*rvd));
|
gtn : t:=genordinalconstnode(ord(lvd>rvd),booldef);
|
||||||
slashn:
|
gten : t:=genordinalconstnode(ord(lvd>=rvd),booldef);
|
||||||
t:=genrealconstnode(lvd/rvd);
|
equaln : t:=genordinalconstnode(ord(lvd=rvd),booldef);
|
||||||
ltn:
|
unequaln : t:=genordinalconstnode(ord(lvd<>rvd),booldef);
|
||||||
t:=genordinalconstnode(ord(lvd<rvd),booldef);
|
else
|
||||||
lten:
|
Message(sym_e_type_mismatch);
|
||||||
t:=genordinalconstnode(ord(lvd<=rvd),booldef);
|
|
||||||
gtn:
|
|
||||||
t:=genordinalconstnode(ord(lvd>rvd),booldef);
|
|
||||||
gten:
|
|
||||||
t:=genordinalconstnode(ord(lvd>=rvd),booldef);
|
|
||||||
equaln:
|
|
||||||
t:=genordinalconstnode(ord(lvd=rvd),booldef);
|
|
||||||
unequaln:
|
|
||||||
t:=genordinalconstnode(ord(lvd<>rvd),booldef);
|
|
||||||
else
|
|
||||||
Message(sym_e_type_mismatch);
|
|
||||||
end;
|
end;
|
||||||
disposetree(p);
|
disposetree(p);
|
||||||
p:=t;
|
p:=t;
|
||||||
firstpass(p);
|
firstpass(p);
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ concating strings ? }
|
||||||
concatstrings:=false;
|
concatstrings:=false;
|
||||||
{$ifdef UseAnsiString}
|
{$ifdef UseAnsiString}
|
||||||
s1:=nil;
|
s1:=nil;
|
||||||
@ -878,10 +891,8 @@ unit pass_1;
|
|||||||
new(s2);
|
new(s2);
|
||||||
{$endif UseAnsiString}
|
{$endif UseAnsiString}
|
||||||
if (lt=ordconstn) and (rt=ordconstn) and
|
if (lt=ordconstn) and (rt=ordconstn) and
|
||||||
(ld^.deftype=orddef) and
|
(ld^.deftype=orddef) and (porddef(ld)^.typ=uchar) and
|
||||||
(porddef(ld)^.typ=uchar) and
|
(rd^.deftype=orddef) and (porddef(rd)^.typ=uchar) then
|
||||||
(rd^.deftype=orddef) and
|
|
||||||
(porddef(rd)^.typ=uchar) then
|
|
||||||
begin
|
begin
|
||||||
{$ifdef UseAnsiString}
|
{$ifdef UseAnsiString}
|
||||||
s1:=strpnew(char(byte(p^.left^.value)));
|
s1:=strpnew(char(byte(p^.left^.value)));
|
||||||
@ -893,9 +904,9 @@ unit pass_1;
|
|||||||
concatstrings:=true;
|
concatstrings:=true;
|
||||||
{$endif UseAnsiString}
|
{$endif UseAnsiString}
|
||||||
end
|
end
|
||||||
else if (lt=stringconstn) and (rt=ordconstn) and
|
else
|
||||||
(rd^.deftype=orddef) and
|
if (lt=stringconstn) and (rt=ordconstn) and
|
||||||
(porddef(rd)^.typ=uchar) then
|
(rd^.deftype=orddef) and (porddef(rd)^.typ=uchar) then
|
||||||
begin
|
begin
|
||||||
{$ifdef UseAnsiString}
|
{$ifdef UseAnsiString}
|
||||||
{ here there is allways the damn #0 problem !! }
|
{ here there is allways the damn #0 problem !! }
|
||||||
@ -989,16 +1000,14 @@ unit pass_1;
|
|||||||
dispose(s2);
|
dispose(s2);
|
||||||
{$endif UseAnsiString}
|
{$endif UseAnsiString}
|
||||||
|
|
||||||
{ we can set this globally but it not allways true }
|
{ if both are orddefs then check sub types }
|
||||||
{ procinfo.flags:=procinfo.flags or pi_do_call; }
|
if (ld^.deftype=orddef) and (rd^.deftype=orddef) then
|
||||||
|
|
||||||
{ if both are boolean: }
|
|
||||||
if ((ld^.deftype=orddef) and
|
|
||||||
(porddef(ld)^.typ in [bool8bit,bool16bit,bool32bit])) and
|
|
||||||
((rd^.deftype=orddef) and
|
|
||||||
(porddef(rd)^.typ in [bool8bit,bool16bit,bool32bit])) then
|
|
||||||
begin
|
begin
|
||||||
case p^.treetype of
|
{ 2 booleans ? }
|
||||||
|
if (porddef(ld)^.typ in [bool8bit,bool16bit,bool32bit]) and
|
||||||
|
(porddef(rd)^.typ in [bool8bit,bool16bit,bool32bit]) then
|
||||||
|
begin
|
||||||
|
case p^.treetype of
|
||||||
andn,orn : begin
|
andn,orn : begin
|
||||||
calcregisters(p,0,0,0);
|
calcregisters(p,0,0,0);
|
||||||
p^.location.loc:=LOC_JUMP;
|
p^.location.loc:=LOC_JUMP;
|
||||||
@ -1008,49 +1017,59 @@ unit pass_1;
|
|||||||
make_bool_equal_size(p);
|
make_bool_equal_size(p);
|
||||||
calcregisters(p,1,0,0);
|
calcregisters(p,1,0,0);
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
Message(sym_e_type_mismatch);
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end
|
||||||
else
|
else
|
||||||
Message(sym_e_type_mismatch);
|
{ Both are chars? only convert to strings for addn }
|
||||||
end;
|
if (porddef(rd)^.typ=uchar) and (porddef(ld)^.typ=uchar) then
|
||||||
|
begin
|
||||||
|
if p^.treetype=addn then
|
||||||
|
begin
|
||||||
|
p^.left:=gentypeconvnode(p^.left,cstringdef);
|
||||||
|
firstpass(p^.left);
|
||||||
|
p^.right:=gentypeconvnode(p^.right,cstringdef);
|
||||||
|
firstpass(p^.right);
|
||||||
|
{ here we call STRCOPY }
|
||||||
|
procinfo.flags:=procinfo.flags or pi_do_call;
|
||||||
|
calcregisters(p,0,0,0);
|
||||||
|
p^.location.loc:=LOC_MEM;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
convdone:=true;
|
||||||
|
end;
|
||||||
end
|
end
|
||||||
{ wenn beides vom Char dann keine Konvertiereung einf<6E>gen }
|
else
|
||||||
{ h”chstens es handelt sich um einen +-Operator }
|
|
||||||
else if ((rd^.deftype=orddef) and (porddef(rd)^.typ=uchar)) and
|
{ is one of the sides a string ? }
|
||||||
((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
|
if (ld^.deftype=stringdef) or (rd^.deftype=stringdef) then
|
||||||
begin
|
begin
|
||||||
if p^.treetype=addn then
|
{ convert other side to a string, if not both site are strings,
|
||||||
begin
|
the typeconv will put give an error if it's not possible }
|
||||||
p^.left:=gentypeconvnode(p^.left,cstringdef);
|
if not((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then
|
||||||
firstpass(p^.left);
|
begin
|
||||||
p^.right:=gentypeconvnode(p^.right,cstringdef);
|
if ld^.deftype=stringdef then
|
||||||
firstpass(p^.right);
|
p^.right:=gentypeconvnode(p^.right,cstringdef)
|
||||||
{ here we call STRCOPY }
|
else
|
||||||
procinfo.flags:=procinfo.flags or pi_do_call;
|
p^.left:=gentypeconvnode(p^.left,cstringdef);
|
||||||
calcregisters(p,0,0,0);
|
firstpass(p^.left);
|
||||||
p^.location.loc:=LOC_MEM;
|
firstpass(p^.right);
|
||||||
end
|
end;
|
||||||
else
|
{ here we call STRCONCAT or STRCMP or STRCOPY }
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
end
|
|
||||||
{ if string and character, then conver the character to a string }
|
|
||||||
else if ((rd^.deftype=stringdef) and
|
|
||||||
((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar))) or
|
|
||||||
((ld^.deftype=stringdef) and
|
|
||||||
((rd^.deftype=orddef) and (porddef(rd)^.typ=uchar))) then
|
|
||||||
begin
|
|
||||||
if ((ld^.deftype=orddef) and (porddef(ld)^.typ=uchar)) then
|
|
||||||
p^.left:=gentypeconvnode(p^.left,cstringdef)
|
|
||||||
else
|
|
||||||
p^.right:=gentypeconvnode(p^.right,cstringdef);
|
|
||||||
firstpass(p^.left);
|
|
||||||
firstpass(p^.right);
|
|
||||||
{ here we call STRCONCAT or STRCMP }
|
|
||||||
procinfo.flags:=procinfo.flags or pi_do_call;
|
procinfo.flags:=procinfo.flags or pi_do_call;
|
||||||
calcregisters(p,0,0,0);
|
calcregisters(p,0,0,0);
|
||||||
p^.location.loc:=LOC_MEM;
|
p^.location.loc:=LOC_MEM;
|
||||||
|
convdone:=true;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
|
||||||
|
{ left side a setdef ? }
|
||||||
if (ld^.deftype=setdef) then
|
if (ld^.deftype=setdef) then
|
||||||
begin
|
begin
|
||||||
|
{ right site must also be a setdef, unless addn is used }
|
||||||
if not(p^.treetype in [subn,symdifn,addn,muln,equaln,unequaln]) or
|
if not(p^.treetype in [subn,symdifn,addn,muln,equaln,unequaln]) or
|
||||||
((rd^.deftype<>setdef) and (p^.treetype<>addn)) then
|
((rd^.deftype<>setdef) and (p^.treetype<>addn)) then
|
||||||
Message(sym_e_type_mismatch);
|
Message(sym_e_type_mismatch);
|
||||||
@ -1064,7 +1083,6 @@ unit pass_1;
|
|||||||
if (psetdef(ld)^.settype<>smallset) and
|
if (psetdef(ld)^.settype<>smallset) and
|
||||||
(psetdef(rd)^.settype=smallset) then
|
(psetdef(rd)^.settype=smallset) then
|
||||||
begin
|
begin
|
||||||
{ Internalerror(34243);}
|
|
||||||
p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
|
p^.right:=gentypeconvnode(p^.right,psetdef(p^.left^.resulttype));
|
||||||
firstpass(p^.right);
|
firstpass(p^.right);
|
||||||
end;
|
end;
|
||||||
@ -1139,44 +1157,43 @@ unit pass_1;
|
|||||||
procinfo.flags:=procinfo.flags or pi_do_call;
|
procinfo.flags:=procinfo.flags or pi_do_call;
|
||||||
p^.location.loc:=LOC_MEM;
|
p^.location.loc:=LOC_MEM;
|
||||||
end;
|
end;
|
||||||
end
|
convdone:=true;
|
||||||
else
|
|
||||||
if ((rd^.deftype=stringdef) and (ld^.deftype=stringdef)) then
|
|
||||||
{ here we call STR... }
|
|
||||||
procinfo.flags:=procinfo.flags or pi_do_call
|
|
||||||
{ if there is a real float, convert both to float 80 bit }
|
|
||||||
else
|
|
||||||
if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ<>f32bit)) or
|
|
||||||
((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ<>f32bit)) then
|
|
||||||
begin
|
|
||||||
p^.right:=gentypeconvnode(p^.right,c64floatdef);
|
|
||||||
p^.left:=gentypeconvnode(p^.left,c64floatdef);
|
|
||||||
firstpass(p^.left);
|
|
||||||
firstpass(p^.right);
|
|
||||||
calcregisters(p,1,1,0);
|
|
||||||
p^.location.loc:=LOC_FPU;
|
|
||||||
end
|
|
||||||
else
|
|
||||||
{ if there is one fix comma number, convert both to 32 bit fixcomma }
|
|
||||||
if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ=f32bit)) or
|
|
||||||
((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ=f32bit)) then
|
|
||||||
begin
|
|
||||||
if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,
|
|
||||||
s16bit,s32bit]) or (p^.treetype<>muln) then
|
|
||||||
p^.right:=gentypeconvnode(p^.right,s32fixeddef);
|
|
||||||
|
|
||||||
if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,
|
|
||||||
s16bit,s32bit]) or (p^.treetype<>muln) then
|
|
||||||
p^.left:=gentypeconvnode(p^.left,s32fixeddef);
|
|
||||||
|
|
||||||
firstpass(p^.left);
|
|
||||||
firstpass(p^.right);
|
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
p^.location.loc:=LOC_REGISTER;
|
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
{ is one a real float ? }
|
||||||
|
if (rd^.deftype=floatdef) or (ld^.deftype=floatdef) then
|
||||||
|
begin
|
||||||
|
{ if one is a fixed, then convert to f32bit }
|
||||||
|
if ((rd^.deftype=floatdef) and (pfloatdef(rd)^.typ=f32bit)) or
|
||||||
|
((ld^.deftype=floatdef) and (pfloatdef(ld)^.typ=f32bit)) then
|
||||||
|
begin
|
||||||
|
if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,s16bit,s32bit,u32bit]) or (p^.treetype<>muln) then
|
||||||
|
p^.right:=gentypeconvnode(p^.right,s32fixeddef);
|
||||||
|
if not(porddef(rd)^.typ in [u8bit,s8bit,u16bit,s16bit,s32bit,u32bit]) or (p^.treetype<>muln) then
|
||||||
|
p^.left:=gentypeconvnode(p^.left,s32fixeddef);
|
||||||
|
firstpass(p^.left);
|
||||||
|
firstpass(p^.right);
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
p^.location.loc:=LOC_REGISTER;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
{ convert both to c64float }
|
||||||
|
begin
|
||||||
|
p^.right:=gentypeconvnode(p^.right,c64floatdef);
|
||||||
|
p^.left:=gentypeconvnode(p^.left,c64floatdef);
|
||||||
|
firstpass(p^.left);
|
||||||
|
firstpass(p^.right);
|
||||||
|
calcregisters(p,1,1,0);
|
||||||
|
p^.location.loc:=LOC_FPU;
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ pointer comperation and subtraction }
|
{ pointer comperation and subtraction }
|
||||||
else if (rd^.deftype=pointerdef) and (ld^.deftype=pointerdef) then
|
if (rd^.deftype=pointerdef) and (ld^.deftype=pointerdef) then
|
||||||
begin
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
p^.right:=gentypeconvnode(p^.right,ld);
|
p^.right:=gentypeconvnode(p^.right,ld);
|
||||||
firstpass(p^.right);
|
firstpass(p^.right);
|
||||||
@ -1197,10 +1214,13 @@ unit pass_1;
|
|||||||
end;
|
end;
|
||||||
else Message(sym_e_type_mismatch);
|
else Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
|
convdone:=true;
|
||||||
end
|
end
|
||||||
else if (rd^.deftype=objectdef) and (ld^.deftype=objectdef) and
|
else
|
||||||
pobjectdef(rd)^.isclass and pobjectdef(ld)^.isclass then
|
|
||||||
begin
|
if (rd^.deftype=objectdef) and (ld^.deftype=objectdef) and
|
||||||
|
pobjectdef(rd)^.isclass and pobjectdef(ld)^.isclass then
|
||||||
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
if pobjectdef(rd)^.isrelated(pobjectdef(ld)) then
|
if pobjectdef(rd)^.isrelated(pobjectdef(ld)) then
|
||||||
p^.right:=gentypeconvnode(p^.right,ld)
|
p^.right:=gentypeconvnode(p^.right,ld)
|
||||||
@ -1213,9 +1233,12 @@ unit pass_1;
|
|||||||
equaln,unequaln : ;
|
equaln,unequaln : ;
|
||||||
else Message(sym_e_type_mismatch);
|
else Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
end
|
convdone:=true;
|
||||||
else if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
|
end
|
||||||
begin
|
else
|
||||||
|
|
||||||
|
if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
|
||||||
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
if pobjectdef(pclassrefdef(rd)^.definition)^.isrelated(pobjectdef(
|
if pobjectdef(pclassrefdef(rd)^.definition)^.isrelated(pobjectdef(
|
||||||
pclassrefdef(ld)^.definition)) then
|
pclassrefdef(ld)^.definition)) then
|
||||||
@ -1229,12 +1252,14 @@ unit pass_1;
|
|||||||
equaln,unequaln : ;
|
equaln,unequaln : ;
|
||||||
else Message(sym_e_type_mismatch);
|
else Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
|
convdone:=true;
|
||||||
end
|
end
|
||||||
|
else
|
||||||
|
|
||||||
{ allows comperasion with nil pointer }
|
{ allows comperasion with nil pointer }
|
||||||
else if (rd^.deftype=objectdef) and
|
if (rd^.deftype=objectdef) and
|
||||||
pobjectdef(rd)^.isclass then
|
pobjectdef(rd)^.isclass then
|
||||||
begin
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
p^.left:=gentypeconvnode(p^.left,rd);
|
p^.left:=gentypeconvnode(p^.left,rd);
|
||||||
firstpass(p^.left);
|
firstpass(p^.left);
|
||||||
@ -1243,89 +1268,102 @@ unit pass_1;
|
|||||||
equaln,unequaln : ;
|
equaln,unequaln : ;
|
||||||
else Message(sym_e_type_mismatch);
|
else Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
end
|
convdone:=true;
|
||||||
else if (ld^.deftype=objectdef) and
|
end
|
||||||
pobjectdef(ld)^.isclass then
|
else
|
||||||
begin
|
|
||||||
p^.location.loc:=LOC_REGISTER;
|
|
||||||
p^.right:=gentypeconvnode(p^.right,ld);
|
|
||||||
firstpass(p^.right);
|
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
case p^.treetype of
|
|
||||||
equaln,unequaln : ;
|
|
||||||
else Message(sym_e_type_mismatch);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else if (rd^.deftype=classrefdef) then
|
|
||||||
begin
|
|
||||||
p^.left:=gentypeconvnode(p^.left,rd);
|
|
||||||
firstpass(p^.left);
|
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
case p^.treetype of
|
|
||||||
equaln,unequaln : ;
|
|
||||||
else Message(sym_e_type_mismatch);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
else if (ld^.deftype=classrefdef) then
|
|
||||||
begin
|
|
||||||
p^.right:=gentypeconvnode(p^.right,ld);
|
|
||||||
firstpass(p^.right);
|
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
case p^.treetype of
|
|
||||||
equaln,unequaln : ;
|
|
||||||
else Message(sym_e_type_mismatch);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
|
|
||||||
else if (rd^.deftype=pointerdef) then
|
if (ld^.deftype=objectdef) and
|
||||||
begin
|
pobjectdef(ld)^.isclass then
|
||||||
|
begin
|
||||||
|
p^.location.loc:=LOC_REGISTER;
|
||||||
|
p^.right:=gentypeconvnode(p^.right,ld);
|
||||||
|
firstpass(p^.right);
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
case p^.treetype of
|
||||||
|
equaln,unequaln : ;
|
||||||
|
else Message(sym_e_type_mismatch);
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
if (rd^.deftype=classrefdef) then
|
||||||
|
begin
|
||||||
|
p^.left:=gentypeconvnode(p^.left,rd);
|
||||||
|
firstpass(p^.left);
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
case p^.treetype of
|
||||||
|
equaln,unequaln : ;
|
||||||
|
else Message(sym_e_type_mismatch);
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
if (ld^.deftype=classrefdef) then
|
||||||
|
begin
|
||||||
|
p^.right:=gentypeconvnode(p^.right,ld);
|
||||||
|
firstpass(p^.right);
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
case p^.treetype of
|
||||||
|
equaln,unequaln : ;
|
||||||
|
else
|
||||||
|
Message(sym_e_type_mismatch);
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
if (rd^.deftype=pointerdef) then
|
||||||
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
p^.left:=gentypeconvnode(p^.left,s32bitdef);
|
p^.left:=gentypeconvnode(p^.left,s32bitdef);
|
||||||
firstpass(p^.left);
|
firstpass(p^.left);
|
||||||
calcregisters(p,1,0,0);
|
calcregisters(p,1,0,0);
|
||||||
if p^.treetype=addn then
|
if p^.treetype=addn then
|
||||||
begin
|
begin
|
||||||
if not(cs_extsyntax in aktmoduleswitches) then
|
if not(cs_extsyntax in aktmoduleswitches) then
|
||||||
Message(sym_e_type_mismatch);
|
Message(sym_e_type_mismatch);
|
||||||
end
|
end
|
||||||
else Message(sym_e_type_mismatch);
|
else
|
||||||
end
|
Message(sym_e_type_mismatch);
|
||||||
else if (ld^.deftype=pointerdef) then
|
convdone:=true;
|
||||||
begin
|
end
|
||||||
|
else
|
||||||
|
|
||||||
|
if (ld^.deftype=pointerdef) then
|
||||||
|
begin
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
p^.right:=gentypeconvnode(p^.right,s32bitdef);
|
p^.right:=gentypeconvnode(p^.right,s32bitdef);
|
||||||
firstpass(p^.right);
|
firstpass(p^.right);
|
||||||
calcregisters(p,1,0,0);
|
calcregisters(p,1,0,0);
|
||||||
case p^.treetype of
|
case p^.treetype of
|
||||||
addn,subn : if not(cs_extsyntax in aktmoduleswitches) then
|
addn,subn : if not(cs_extsyntax in aktmoduleswitches) then
|
||||||
Message(sym_e_type_mismatch);
|
Message(sym_e_type_mismatch);
|
||||||
else Message(sym_e_type_mismatch);
|
else
|
||||||
|
Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
|
convdone:=true;
|
||||||
end
|
end
|
||||||
else if (rd^.deftype=procvardef) and (ld^.deftype=procvardef) and
|
else
|
||||||
is_equal(rd,ld) then
|
|
||||||
begin
|
if (rd^.deftype=procvardef) and (ld^.deftype=procvardef) and is_equal(rd,ld) then
|
||||||
|
begin
|
||||||
calcregisters(p,1,0,0);
|
calcregisters(p,1,0,0);
|
||||||
p^.location.loc:=LOC_REGISTER;
|
p^.location.loc:=LOC_REGISTER;
|
||||||
case p^.treetype of
|
case p^.treetype of
|
||||||
equaln,unequaln : ;
|
equaln,unequaln : ;
|
||||||
else Message(sym_e_type_mismatch);
|
else
|
||||||
|
Message(sym_e_type_mismatch);
|
||||||
end;
|
end;
|
||||||
end
|
convdone:=true;
|
||||||
else if (ld^.deftype=enumdef) and (rd^.deftype=enumdef)
|
end
|
||||||
and (is_equal(ld,rd)) then
|
else
|
||||||
begin
|
|
||||||
calcregisters(p,1,0,0);
|
|
||||||
case p^.treetype of
|
|
||||||
equaln,unequaln,
|
|
||||||
ltn,lten,gtn,gten : ;
|
|
||||||
else Message(sym_e_type_mismatch);
|
|
||||||
end;
|
|
||||||
end
|
|
||||||
{$ifdef SUPPORT_MMX}
|
{$ifdef SUPPORT_MMX}
|
||||||
else if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld)
|
if (cs_mmx in aktlocalswitches) and is_mmx_able_array(ld) and
|
||||||
and is_mmx_able_array(rd) and is_equal(ld,rd) then
|
is_mmx_able_array(rd) and is_equal(ld,rd) then
|
||||||
begin
|
begin
|
||||||
firstpass(p^.right);
|
firstpass(p^.right);
|
||||||
firstpass(p^.left);
|
firstpass(p^.left);
|
||||||
case p^.treetype of
|
case p^.treetype of
|
||||||
@ -1341,10 +1379,24 @@ unit pass_1;
|
|||||||
end;
|
end;
|
||||||
p^.location.loc:=LOC_MMXREGISTER;
|
p^.location.loc:=LOC_MMXREGISTER;
|
||||||
calcregisters(p,0,0,1);
|
calcregisters(p,0,0,1);
|
||||||
end
|
convdone:=true;
|
||||||
|
end
|
||||||
|
else
|
||||||
{$endif SUPPORT_MMX}
|
{$endif SUPPORT_MMX}
|
||||||
|
|
||||||
|
if (ld^.deftype=enumdef) and (rd^.deftype=enumdef) and (is_equal(ld,rd)) then
|
||||||
|
begin
|
||||||
|
calcregisters(p,1,0,0);
|
||||||
|
case p^.treetype of
|
||||||
|
equaln,unequaln,
|
||||||
|
ltn,lten,gtn,gten : ;
|
||||||
|
else Message(sym_e_type_mismatch);
|
||||||
|
end;
|
||||||
|
convdone:=true;
|
||||||
|
end;
|
||||||
|
|
||||||
{ the general solution is to convert to 32 bit int }
|
{ the general solution is to convert to 32 bit int }
|
||||||
else
|
if not convdone then
|
||||||
begin
|
begin
|
||||||
{ but an int/int gives real/real! }
|
{ but an int/int gives real/real! }
|
||||||
if p^.treetype=slashn then
|
if p^.treetype=slashn then
|
||||||
@ -5206,7 +5258,11 @@ unit pass_1;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.56 1998-08-18 09:24:42 pierre
|
Revision 1.57 1998-08-19 00:42:39 peter
|
||||||
|
+ subrange types for enums
|
||||||
|
+ checking for bounds type with ranges
|
||||||
|
|
||||||
|
Revision 1.56 1998/08/18 09:24:42 pierre
|
||||||
* small warning position bug fixed
|
* small warning position bug fixed
|
||||||
* support_mmx switches splitting was missing
|
* support_mmx switches splitting was missing
|
||||||
* rhide error and warning output corrected
|
* rhide error and warning output corrected
|
||||||
|
|||||||
@ -82,9 +82,9 @@ unit pdecl;
|
|||||||
sym : psym;
|
sym : psym;
|
||||||
ps : pconstset;
|
ps : pconstset;
|
||||||
pd : pbestreal;
|
pd : pbestreal;
|
||||||
{$ifdef USEANSISTRING}
|
{$ifdef USEANSISTRING}
|
||||||
sp : pstring;
|
sp : pstring;
|
||||||
{$endif USEANSISTRING}
|
{$endif USEANSISTRING}
|
||||||
begin
|
begin
|
||||||
consume(_CONST);
|
consume(_CONST);
|
||||||
repeat
|
repeat
|
||||||
@ -364,8 +364,8 @@ unit pdecl;
|
|||||||
consume(SEMICOLON);
|
consume(SEMICOLON);
|
||||||
{ insert in the symtable }
|
{ insert in the symtable }
|
||||||
Csym:=new(pvarsym,init_C(s,C_name,p));
|
Csym:=new(pvarsym,init_C(s,C_name,p));
|
||||||
if export_Csym then
|
if export_Csym then
|
||||||
inc(Csym^.refs);
|
inc(Csym^.refs);
|
||||||
if extern_Csym then
|
if extern_Csym then
|
||||||
begin
|
begin
|
||||||
Csym^.var_options:=Csym^.var_options or vo_is_external;
|
Csym^.var_options:=Csym^.var_options or vo_is_external;
|
||||||
@ -1432,6 +1432,7 @@ unit pdecl;
|
|||||||
pt1,pt2 : ptree;
|
pt1,pt2 : ptree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
p:=nil;
|
||||||
{ use of current parsed object ? }
|
{ use of current parsed object ? }
|
||||||
if (token=ID) and (testcurobject=2) and (curobjectname=pattern) then
|
if (token=ID) and (testcurobject=2) and (curobjectname=pattern) then
|
||||||
begin
|
begin
|
||||||
@ -1455,17 +1456,31 @@ unit pdecl;
|
|||||||
pt2:=comp_expr(not(ignore_equal));
|
pt2:=comp_expr(not(ignore_equal));
|
||||||
do_firstpass(pt2);
|
do_firstpass(pt2);
|
||||||
{ valid expression ? }
|
{ valid expression ? }
|
||||||
if (pt1^.treetype<>ordconstn) or
|
if (pt1^.treetype<>ordconstn) or (pt2^.treetype<>ordconstn) then
|
||||||
(pt2^.treetype<>ordconstn) then
|
Message(sym_e_error_in_type_def)
|
||||||
Begin
|
|
||||||
Message(sym_e_error_in_type_def);
|
|
||||||
{ Here we create a node type with a range of 0 }
|
|
||||||
{ To make sure that no crashes will occur later }
|
|
||||||
{ on in the compiler. }
|
|
||||||
p:=new(porddef,init(uauto,0,0));
|
|
||||||
end
|
|
||||||
else
|
else
|
||||||
p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
|
begin
|
||||||
|
{ Check bounds }
|
||||||
|
if pt2^.value<pt1^.value then
|
||||||
|
Message(cg_e_upper_lower_than_lower)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ is one an enum ? }
|
||||||
|
if (pt1^.resulttype^.deftype=enumdef) or (pt2^.resulttype^.deftype=enumdef) then
|
||||||
|
begin
|
||||||
|
{ both must be the have the same (enumdef) definition, else its a type mismatch }
|
||||||
|
if (pt1^.resulttype=pt2^.resulttype) then
|
||||||
|
p:=new(penumdef,init_subrange(penumdef(pt1^.resulttype),pt1^.value,pt2^.value))
|
||||||
|
else
|
||||||
|
Message(sym_e_type_mismatch);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ both must be are orddefs, create an uauto orddef }
|
||||||
|
p:=new(porddef,init(uauto,pt1^.value,pt2^.value));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
disposetree(pt2);
|
disposetree(pt2);
|
||||||
end;
|
end;
|
||||||
disposetree(pt1);
|
disposetree(pt1);
|
||||||
@ -1490,13 +1505,13 @@ unit pdecl;
|
|||||||
if p=nil then
|
if p=nil then
|
||||||
begin
|
begin
|
||||||
ap:=new(parraydef,
|
ap:=new(parraydef,
|
||||||
init(0,penumdef(pt^.resulttype)^.max,pt^.resulttype));
|
init(penumdef(pt^.resulttype)^.min,penumdef(pt^.resulttype)^.max,pt^.resulttype));
|
||||||
p:=ap;
|
p:=ap;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
ap^.definition:=new(parraydef,
|
ap^.definition:=new(parraydef,
|
||||||
init(0,penumdef(pt^.resulttype)^.max,pt^.resulttype));
|
init(penumdef(pt^.resulttype)^.min,penumdef(pt^.resulttype)^.max,pt^.resulttype));
|
||||||
ap:=parraydef(ap^.definition);
|
ap:=parraydef(ap^.definition);
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
@ -1885,7 +1900,11 @@ unit pdecl;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.38 1998-08-12 19:20:39 peter
|
Revision 1.39 1998-08-19 00:42:40 peter
|
||||||
|
+ subrange types for enums
|
||||||
|
+ checking for bounds type with ranges
|
||||||
|
|
||||||
|
Revision 1.38 1998/08/12 19:20:39 peter
|
||||||
+ public is the same as export for c_vars
|
+ public is the same as export for c_vars
|
||||||
* a exported/public c_var incs now the refcount
|
* a exported/public c_var incs now the refcount
|
||||||
|
|
||||||
|
|||||||
@ -495,22 +495,41 @@
|
|||||||
begin
|
begin
|
||||||
tdef.init;
|
tdef.init;
|
||||||
deftype:=enumdef;
|
deftype:=enumdef;
|
||||||
|
min:=0;
|
||||||
max:=0;
|
max:=0;
|
||||||
savesize:=Sizeof(longint);
|
savesize:=Sizeof(longint);
|
||||||
has_jumps:=false;
|
has_jumps:=false;
|
||||||
{$ifdef GDB}
|
basedef:=nil;
|
||||||
first := Nil;
|
first:=nil;
|
||||||
{$endif GDB}
|
end;
|
||||||
|
|
||||||
|
constructor tenumdef.init_subrange(_basedef:penumdef;_min,_max:longint);
|
||||||
|
begin
|
||||||
|
tdef.init;
|
||||||
|
deftype:=enumdef;
|
||||||
|
min:=_min;
|
||||||
|
max:=_max;
|
||||||
|
basedef:=_basedef;
|
||||||
|
savesize:=Sizeof(longint);
|
||||||
|
has_jumps:=false;
|
||||||
|
first:=nil;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
constructor tenumdef.load;
|
constructor tenumdef.load;
|
||||||
begin
|
begin
|
||||||
tdef.load;
|
tdef.load;
|
||||||
deftype:=enumdef;
|
deftype:=enumdef;
|
||||||
|
basedef:=penumdef(readdefref);
|
||||||
|
min:=readlong;
|
||||||
max:=readlong;
|
max:=readlong;
|
||||||
savesize:=Sizeof(longint);
|
savesize:=Sizeof(longint);
|
||||||
has_jumps:=false;
|
has_jumps:=false;
|
||||||
first := Nil;
|
first:=Nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tenumdef.deref;
|
||||||
|
begin
|
||||||
|
resolvedef(pdef(basedef));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor tenumdef.done;
|
destructor tenumdef.done;
|
||||||
@ -519,9 +538,10 @@
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure tenumdef.write;
|
procedure tenumdef.write;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
tdef.write;
|
tdef.write;
|
||||||
|
writedefref(basedef);
|
||||||
|
writelong(min);
|
||||||
writelong(max);
|
writelong(max);
|
||||||
current_ppu^.writeentry(ibenumdef);
|
current_ppu^.writeentry(ibenumdef);
|
||||||
end;
|
end;
|
||||||
@ -2510,7 +2530,11 @@
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.22 1998-08-17 10:10:10 peter
|
Revision 1.23 1998-08-19 00:42:42 peter
|
||||||
|
+ subrange types for enums
|
||||||
|
+ checking for bounds type with ranges
|
||||||
|
|
||||||
|
Revision 1.22 1998/08/17 10:10:10 peter
|
||||||
- removed OLDPPU
|
- removed OLDPPU
|
||||||
|
|
||||||
Revision 1.21 1998/08/10 14:50:28 peter
|
Revision 1.21 1998/08/10 14:50:28 peter
|
||||||
|
|||||||
@ -151,7 +151,7 @@ unit types;
|
|||||||
else
|
else
|
||||||
proc_to_procvar_equal:=false;
|
proc_to_procvar_equal:=false;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ returns true, if def uses FPU }
|
{ returns true, if def uses FPU }
|
||||||
function is_fpu(def : pdef) : boolean;
|
function is_fpu(def : pdef) : boolean;
|
||||||
begin
|
begin
|
||||||
@ -296,7 +296,7 @@ unit types;
|
|||||||
h:=porddef(def)^.high;
|
h:=porddef(def)^.high;
|
||||||
end;
|
end;
|
||||||
enumdef : begin
|
enumdef : begin
|
||||||
l:=0;
|
l:=penumdef(def)^.min;
|
||||||
h:=penumdef(def)^.max;
|
h:=penumdef(def)^.max;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -878,7 +878,11 @@ unit types;
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.20 1998-08-18 14:17:14 pierre
|
Revision 1.21 1998-08-19 00:42:45 peter
|
||||||
|
+ subrange types for enums
|
||||||
|
+ checking for bounds type with ranges
|
||||||
|
|
||||||
|
Revision 1.20 1998/08/18 14:17:14 pierre
|
||||||
* bug about assigning the return value of a function to
|
* bug about assigning the return value of a function to
|
||||||
a procvar fixed : warning
|
a procvar fixed : warning
|
||||||
assigning a proc to a procvar need @ in FPC mode !!
|
assigning a proc to a procvar need @ in FPC mode !!
|
||||||
@ -896,7 +900,11 @@ end.
|
|||||||
Revision 1.17 1998/08/05 16:00:17 florian
|
Revision 1.17 1998/08/05 16:00:17 florian
|
||||||
* some fixes for ansi strings
|
* some fixes for ansi strings
|
||||||
* $log$ to $Log$
|
* $log$ to $Log$
|
||||||
* $log$ to Revision 1.20 1998-08-18 14:17:14 pierre
|
* $log$ to Revision 1.21 1998-08-19 00:42:45 peter
|
||||||
|
* $log$ to + subrange types for enums
|
||||||
|
* $log$ to + checking for bounds type with ranges
|
||||||
|
* $log$ to
|
||||||
|
* $log$ to Revision 1.20 1998/08/18 14:17:14 pierre
|
||||||
* $log$ to * bug about assigning the return value of a function to
|
* $log$ to * bug about assigning the return value of a function to
|
||||||
* $log$ to a procvar fixed : warning
|
* $log$ to a procvar fixed : warning
|
||||||
* $log$ to assigning a proc to a procvar need @ in FPC mode !!
|
* $log$ to assigning a proc to a procvar need @ in FPC mode !!
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user