mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 13:09:16 +02:00
* fixed an internalerror with writeln
* fixed arrayconstructor_to_set to force the generation of better code
and added a more strict type checking
This commit is contained in:
florian
parent
0ab87d5ed8
commit
2f623caf67
@ -269,7 +269,7 @@ implementation
|
||||
{$endif noAllocEdi}
|
||||
|
||||
emit_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_EDI);
|
||||
|
||||
del_reference(node^.left^.location.reference);
|
||||
{ skip to the next parameter }
|
||||
node:=node^.right;
|
||||
end
|
||||
@ -1507,7 +1507,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.93 2000-02-09 13:22:47 peter
|
||||
Revision 1.94 2000-02-13 22:46:27 florian
|
||||
* fixed an internalerror with writeln
|
||||
* fixed arrayconstructor_to_set to force the generation of better code
|
||||
and added a more strict type checking
|
||||
|
||||
Revision 1.93 2000/02/09 13:22:47 peter
|
||||
* log truncated
|
||||
|
||||
Revision 1.92 2000/01/26 12:02:29 peter
|
||||
@ -1599,4 +1604,4 @@ end.
|
||||
+ added $D- for TP in symtable.pas else it can't be compiled anymore
|
||||
(too much symbols :()
|
||||
|
||||
}
|
||||
}
|
||||
@ -1536,8 +1536,17 @@ Begin
|
||||
AS_WORD : size:=S_W;
|
||||
AS_BYTE : size:=S_B;
|
||||
AS_QWORD : begin
|
||||
if opcode in [A_FCOM,A_FCOMP,A_FDIV,
|
||||
A_FDIVR,A_FMUL,A_FSUB,A_FSUBR,A_FLD,A_FST,A_FSTP,A_FADD] then
|
||||
if (opcode=A_FCOM) or
|
||||
(opcode=A_FCOMP) or
|
||||
(opcode=A_FDIV) or
|
||||
(opcode=A_FDIVR) or
|
||||
(opcode=A_FMUL) or
|
||||
(opcode=A_FSUB) or
|
||||
(opcode=A_FSUBR) or
|
||||
(opcode=A_FLD) or
|
||||
(opcode=A_FST) or
|
||||
(opcode=A_FSTP) or
|
||||
(opcode=A_FADD) then
|
||||
size:=S_FL
|
||||
else
|
||||
size:=S_IQ;
|
||||
@ -1774,7 +1783,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.58 2000-02-09 13:23:02 peter
|
||||
Revision 1.59 2000-02-13 22:46:28 florian
|
||||
* fixed an internalerror with writeln
|
||||
* fixed arrayconstructor_to_set to force the generation of better code
|
||||
and added a more strict type checking
|
||||
|
||||
Revision 1.58 2000/02/09 13:23:02 peter
|
||||
* log truncated
|
||||
|
||||
Revision 1.57 2000/01/07 01:14:36 peter
|
||||
@ -1842,4 +1856,4 @@ end.
|
||||
* string constants are now handle correctly and also allowed in
|
||||
constant expressions
|
||||
|
||||
}
|
||||
}
|
||||
@ -415,7 +415,7 @@ implementation
|
||||
make_bool_equal_size(p);
|
||||
p^.location.loc:=LOC_JUMP;
|
||||
end;
|
||||
xorn,ltn,lten,gtn,gten :
|
||||
xorn,ltn,lten,gtn,gten:
|
||||
begin
|
||||
make_bool_equal_size(p);
|
||||
if (p^.left^.location.loc in [LOC_JUMP,LOC_FLAGS]) and
|
||||
@ -1258,7 +1258,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.66 2000-02-13 14:21:51 jonas
|
||||
Revision 1.67 2000-02-13 22:46:28 florian
|
||||
* fixed an internalerror with writeln
|
||||
* fixed arrayconstructor_to_set to force the generation of better code
|
||||
and added a more strict type checking
|
||||
|
||||
Revision 1.66 2000/02/13 14:21:51 jonas
|
||||
* modifications to make the compiler functional when compiled with
|
||||
-Or
|
||||
|
||||
@ -1338,4 +1343,4 @@ end.
|
||||
Revision 1.45 1999/09/08 16:05:29 peter
|
||||
* pointer add/sub is now as expected and the same results as inc/dec
|
||||
|
||||
}
|
||||
}
|
||||
@ -66,6 +66,8 @@ implementation
|
||||
|
||||
procedure update_constsethi(p:pdef);
|
||||
begin
|
||||
if pd=nil then
|
||||
pd:=p;
|
||||
if ((p^.deftype=orddef) and
|
||||
(porddef(p)^.high>constsethi)) then
|
||||
constsethi:=porddef(p)^.high
|
||||
@ -134,76 +136,105 @@ implementation
|
||||
orddef:
|
||||
begin
|
||||
getrange(p2^.resulttype,lr,hr);
|
||||
if assigned(p3) then
|
||||
begin
|
||||
{ this isn't good, you'll get problems with
|
||||
type t010 = 0..10;
|
||||
ts = set of t010;
|
||||
var s : ts;b : t010
|
||||
begin s:=[1,2,b]; end.
|
||||
if is_integer(p3^.resulttype) then
|
||||
begin
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
firstpass(p3);
|
||||
end;
|
||||
}
|
||||
|
||||
if is_integer(p2^.resulttype) and
|
||||
((lr<0) or (hr>255)) then
|
||||
begin
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
firstpass(p2);
|
||||
end;
|
||||
{ set settype result }
|
||||
if pd=nil then
|
||||
pd:=p2^.resulttype;
|
||||
if not(is_equal(pd,p2^.resulttype)) then
|
||||
begin
|
||||
aktfilepos:=p2^.fileinfo;
|
||||
CGMessage(type_e_typeconflict_in_set);
|
||||
disposetree(p2);
|
||||
if assigned(pd) and not(is_equal(pd,p3^.resulttype)) then
|
||||
begin
|
||||
aktfilepos:=p3^.fileinfo;
|
||||
CGMessage(type_e_typeconflict_in_set);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
||||
begin
|
||||
if not(is_integer(p3^.resulttype)) then
|
||||
pd:=p3^.resulttype
|
||||
else
|
||||
begin
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
firstpass(p2);
|
||||
firstpass(p3);
|
||||
end;
|
||||
|
||||
for l:=p2^.value to p3^.value do
|
||||
do_set(l);
|
||||
disposetree(p3);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p2^.resulttype);
|
||||
p2:=gentypeconvnode(p2,pd);
|
||||
firstpass(p2);
|
||||
|
||||
update_constsethi(p3^.resulttype);
|
||||
p3:=gentypeconvnode(p3,pd);
|
||||
firstpass(p3);
|
||||
|
||||
|
||||
if assigned(pd) then
|
||||
p3:=gentypeconvnode(p3,pd)
|
||||
else
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
firstpass(p3);
|
||||
p4:=gennode(setelementn,p2,p3);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if assigned(p3) then
|
||||
{ Single value }
|
||||
if p2^.treetype=ordconstn then
|
||||
begin
|
||||
if is_integer(p3^.resulttype) then
|
||||
begin
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
firstpass(p3);
|
||||
end;
|
||||
if not(is_equal(pd,p3^.resulttype)) then
|
||||
begin
|
||||
aktfilepos:=p3^.fileinfo;
|
||||
CGMessage(type_e_typeconflict_in_set);
|
||||
end
|
||||
if not(is_integer(p2^.resulttype)) then
|
||||
update_constsethi(p2^.resulttype)
|
||||
else
|
||||
begin
|
||||
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
||||
begin
|
||||
for l:=p2^.value to p3^.value do
|
||||
do_set(l);
|
||||
disposetree(p3);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p3^.resulttype);
|
||||
p4:=gennode(setelementn,p2,p3);
|
||||
end;
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
firstpass(p2);
|
||||
end;
|
||||
|
||||
do_set(p2^.value);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Single value }
|
||||
if p2^.treetype=ordconstn then
|
||||
begin
|
||||
do_set(p2^.value);
|
||||
disposetree(p2);
|
||||
end
|
||||
update_constsethi(p2^.resulttype);
|
||||
|
||||
if assigned(pd) then
|
||||
p2:=gentypeconvnode(p2,pd)
|
||||
else
|
||||
begin
|
||||
update_constsethi(p2^.resulttype);
|
||||
p4:=gennode(setelementn,p2,nil);
|
||||
end;
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
firstpass(p2);
|
||||
|
||||
p4:=gennode(setelementn,p2,nil);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
stringdef : begin
|
||||
if pd=nil then
|
||||
pd:=cchardef;
|
||||
if not(is_equal(pd,cchardef)) then
|
||||
CGMessage(type_e_typeconflict_in_set)
|
||||
{ if we've already set elements which are constants }
|
||||
{ throw an error }
|
||||
if ((pd=nil) and assigned(buildp)) or
|
||||
not(is_equal(pd,cchardef)) then
|
||||
CGMessage(type_e_typeconflict_in_set)
|
||||
else
|
||||
for l:=1 to length(pstring(p2^.value_str)^) do
|
||||
do_set(ord(pstring(p2^.value_str)^[l]));
|
||||
if pd=nil then
|
||||
pd:=cchardef;
|
||||
disposetree(p2);
|
||||
end;
|
||||
else
|
||||
@ -217,6 +248,11 @@ implementation
|
||||
p:=p^.right;
|
||||
putnode(p2);
|
||||
end;
|
||||
if (pd=nil) then
|
||||
begin
|
||||
pd:=u8bitdef;
|
||||
constsethi:=255;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -975,7 +1011,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.59 2000-02-09 13:23:07 peter
|
||||
Revision 1.60 2000-02-13 22:46:28 florian
|
||||
* fixed an internalerror with writeln
|
||||
* fixed arrayconstructor_to_set to force the generation of better code
|
||||
and added a more strict type checking
|
||||
|
||||
Revision 1.59 2000/02/09 13:23:07 peter
|
||||
* log truncated
|
||||
|
||||
Revision 1.58 2000/01/09 23:16:07 peter
|
||||
@ -1043,4 +1084,4 @@ end.
|
||||
* moved bitmask constants to sets
|
||||
* some other type/const renamings
|
||||
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user