mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 21:11:23 +02:00
* fixed a problem with case and negative labels if a linear list
was generated (fixes tests\test\testcase)
This commit is contained in:
parent
738d994e1a
commit
5c11706a27
@ -532,6 +532,7 @@ implementation
|
|||||||
jumptable_no_range : boolean;
|
jumptable_no_range : boolean;
|
||||||
{ where to put the jump table }
|
{ where to put the jump table }
|
||||||
jumpsegment : paasmoutput;
|
jumpsegment : paasmoutput;
|
||||||
|
min_label : longint;
|
||||||
|
|
||||||
procedure gentreejmp(p : pcaserecord);
|
procedure gentreejmp(p : pcaserecord);
|
||||||
|
|
||||||
@ -577,6 +578,51 @@ implementation
|
|||||||
gentreejmp(p^.greater);
|
gentreejmp(p^.greater);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure genlinearcmplist(hp : pcaserecord);
|
||||||
|
|
||||||
|
var
|
||||||
|
first : boolean;
|
||||||
|
last : longint;
|
||||||
|
|
||||||
|
procedure genitem(t : pcaserecord);
|
||||||
|
|
||||||
|
begin
|
||||||
|
if assigned(t^.less) then
|
||||||
|
genitem(t^.less);
|
||||||
|
if t^._low=t^._high then
|
||||||
|
begin
|
||||||
|
emit_const_reg(A_CMP,opsize,t^._low,hregister);
|
||||||
|
emitjmp(C_Z,t^.statement);
|
||||||
|
last:=t^._low;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
{ if there is no unused label between the last and the }
|
||||||
|
{ present label then the lower limit can be checked }
|
||||||
|
{ immediately. else check the range in between: }
|
||||||
|
if first or (t^._low-last>1) then
|
||||||
|
begin
|
||||||
|
emit_const_reg(A_CMP,opsize,t^._low,hregister);
|
||||||
|
emitjmp(jmp_le,elselabel);
|
||||||
|
end;
|
||||||
|
|
||||||
|
emit_const_reg(A_CMP,opsize,t^._high,hregister);
|
||||||
|
emitjmp(jmp_lee,t^.statement);
|
||||||
|
|
||||||
|
last:=t^._high;
|
||||||
|
end;
|
||||||
|
first:=false;
|
||||||
|
if assigned(t^.greater) then
|
||||||
|
genitem(t^.greater);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
last:=0;
|
||||||
|
first:=true;
|
||||||
|
genitem(hp);
|
||||||
|
emitjmp(C_None,elselabel);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure genlinearlist(hp : pcaserecord);
|
procedure genlinearlist(hp : pcaserecord);
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -646,10 +692,16 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
last:=0;
|
{ do we need to generate cmps? }
|
||||||
first:=true;
|
if with_sign and (min_label<0) then
|
||||||
genitem(hp);
|
genlinearcmplist(hp)
|
||||||
emitjmp(C_None,elselabel);
|
else
|
||||||
|
begin
|
||||||
|
last:=0;
|
||||||
|
first:=true;
|
||||||
|
genitem(hp);
|
||||||
|
emitjmp(C_None,elselabel);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
|
procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
|
||||||
@ -729,7 +781,7 @@ implementation
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
lv,hv,min_label,max_label,labels : longint;
|
lv,hv,max_label,labels : longint;
|
||||||
max_linear_list : longint;
|
max_linear_list : longint;
|
||||||
{$ifdef Delphi}
|
{$ifdef Delphi}
|
||||||
dist : cardinal;
|
dist : cardinal;
|
||||||
@ -904,7 +956,11 @@ implementation
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.50 2000-05-11 09:56:20 pierre
|
Revision 1.51 2000-05-16 18:56:04 florian
|
||||||
|
* fixed a problem with case and negative labels if a linear list
|
||||||
|
was generated (fixes tests\test\testcase)
|
||||||
|
|
||||||
|
Revision 1.50 2000/05/11 09:56:20 pierre
|
||||||
* fixed several compare problems between longints and
|
* fixed several compare problems between longints and
|
||||||
const > $80000000 that are treated as int64 constanst
|
const > $80000000 that are treated as int64 constanst
|
||||||
by Delphi reported by Kovacs Attila Zoltan
|
by Delphi reported by Kovacs Attila Zoltan
|
||||||
@ -962,4 +1018,4 @@ end.
|
|||||||
* moved bitmask constants to sets
|
* moved bitmask constants to sets
|
||||||
* some other type/const renamings
|
* some other type/const renamings
|
||||||
|
|
||||||
}
|
}
|
Loading…
Reference in New Issue
Block a user