mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 08:29:35 +02:00
* fixed/added overflow checking in generic unarminusn code + test
+ added support for OP_NEG/OP_NOT in tcg64f386.a_op64_ref_reg (needed
for the above)
git-svn-id: trunk@9528 -
This commit is contained in:
Jonas Maebe
parent
3d89822bc4
commit
ca7650418d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -6837,6 +6837,7 @@ tests/test/cg/ttryfin1.pp svneol=native#text/plain
|
||||
tests/test/cg/ttryfin2.pp svneol=native#text/plain
|
||||
tests/test/cg/ttryfin3.pp svneol=native#text/plain
|
||||
tests/test/cg/ttryfin4.pp svneol=native#text/plain
|
||||
tests/test/cg/tumin.pp svneol=native#text/plain
|
||||
tests/test/cg/tvec.pp svneol=native#text/plain
|
||||
tests/test/cg/uprintf3.pp svneol=native#text/plain
|
||||
tests/test/cg/variants/ivarol10.pp svneol=native#text/plain
|
||||
|
||||
@ -742,12 +742,20 @@ unit cgcpu;
|
||||
op1,op2 : TAsmOp;
|
||||
tempref : treference;
|
||||
begin
|
||||
get_64bit_ops(op,op1,op2);
|
||||
tempref:=ref;
|
||||
tcgx86(cg).make_simple_ref(list,tempref);
|
||||
list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo));
|
||||
inc(tempref.offset,4);
|
||||
list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
|
||||
if not(op in [OP_NEG,OP_NOT]) then
|
||||
begin
|
||||
get_64bit_ops(op,op1,op2);
|
||||
tempref:=ref;
|
||||
tcgx86(cg).make_simple_ref(list,tempref);
|
||||
list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo));
|
||||
inc(tempref.offset,4);
|
||||
list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
|
||||
end
|
||||
else
|
||||
begin
|
||||
a_load64_ref_reg(list,ref,reg);
|
||||
a_op64_reg_reg(list,op,size,reg,reg);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -173,13 +173,29 @@ implementation
|
||||
|
||||
{$ifndef cpu64bit}
|
||||
procedure tcgunaryminusnode.second_64bit;
|
||||
var
|
||||
tr: tregister;
|
||||
hl: tasmlabel;
|
||||
begin
|
||||
secondpass(left);
|
||||
{ load left operator in a register }
|
||||
location_copy(location,left.location);
|
||||
location_force_reg(current_asmdata.CurrAsmList,location,OS_64,false);
|
||||
cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NEG,OS_64,
|
||||
location,joinreg64(location.register64.reglo,location.register64.reghi));
|
||||
location_reset(location,LOC_REGISTER,left.location.size);
|
||||
location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
|
||||
location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
|
||||
cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NEG,OS_S64,
|
||||
left.location,joinreg64(location.register64.reglo,location.register64.reghi));
|
||||
{ there's only overflow in case left was low(int64) -> -left = left }
|
||||
if (cs_check_overflow in current_settings.localswitches) then
|
||||
begin
|
||||
tr:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
|
||||
cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
|
||||
aint($80000000),location.register64.reghi,tr);
|
||||
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,
|
||||
location.register64.reglo,tr);
|
||||
current_asmdata.getjumplabel(hl);
|
||||
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl);
|
||||
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
|
||||
cg.a_label(current_asmdata.CurrAsmList,hl);
|
||||
end;
|
||||
end;
|
||||
{$endif cpu64bit}
|
||||
|
||||
@ -215,12 +231,22 @@ implementation
|
||||
|
||||
|
||||
procedure tcgunaryminusnode.second_integer;
|
||||
var
|
||||
hl: tasmlabel;
|
||||
begin
|
||||
secondpass(left);
|
||||
{ load left operator in a register }
|
||||
location_copy(location,left.location);
|
||||
location_force_reg(current_asmdata.CurrAsmList,location,OS_SINT,false);
|
||||
cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_SINT,location.register,location.register);
|
||||
|
||||
if (cs_check_overflow in current_settings.localswitches) then
|
||||
begin
|
||||
current_asmdata.getjumplabel(hl);
|
||||
cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl);
|
||||
cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW');
|
||||
cg.a_label(current_asmdata.CurrAsmList,hl);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
280
tests/test/cg/tumin.pp
Normal file
280
tests/test/cg/tumin.pp
Normal file
@ -0,0 +1,280 @@
|
||||
{****************************************************************}
|
||||
{ CODE GENERATOR TEST PROGRAM }
|
||||
{****************************************************************}
|
||||
{ NODE TESTED : secondunaryminus() }
|
||||
{****************************************************************}
|
||||
{ PRE-REQUISITES: secondload() }
|
||||
{ secondassign() }
|
||||
{****************************************************************}
|
||||
{ DEFINES: VERBOSE = Write test information to screen }
|
||||
{ FPC = Target is FreePascal compiler }
|
||||
{****************************************************************}
|
||||
{ REMARKS: }
|
||||
{ }
|
||||
{ }
|
||||
{ }
|
||||
{****************************************************************}
|
||||
{$mode objfpc}
|
||||
|
||||
Program tumin;
|
||||
|
||||
{----------------------------------------------------}
|
||||
{ Cases to test: }
|
||||
{ CURRENT NODE (result) }
|
||||
{ - LOC_REGISTER }
|
||||
{ - LOC_FLAGS }
|
||||
{ LEFT NODE (value to complement) }
|
||||
{ possible cases : int64,byte,word,longint }
|
||||
{ boolean }
|
||||
{ - LOC_CREGISTER }
|
||||
{ - LOC_REFERENCE / LOC_MEM }
|
||||
{ - LOC_REGISTER }
|
||||
{ - LOC_FLAGS }
|
||||
{ - LOC_JUMP }
|
||||
{----------------------------------------------------}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
|
||||
{$IFNDEF FPC}
|
||||
type smallint = integer;
|
||||
{$ENDIF}
|
||||
|
||||
function getintres : smallint;
|
||||
begin
|
||||
getintres := $7F7F;
|
||||
end;
|
||||
|
||||
function getbyteboolval : boolean;
|
||||
begin
|
||||
getbyteboolval := TRUE;
|
||||
end;
|
||||
|
||||
procedure test(value, required: longint);
|
||||
begin
|
||||
if value <> required then
|
||||
begin
|
||||
writeln('Got ',value,' instead of ',required);
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
end;
|
||||
|
||||
|
||||
{$Q+}
|
||||
{$R+}
|
||||
|
||||
var
|
||||
caught: boolean;
|
||||
longres : longint;
|
||||
cardres : cardinal;
|
||||
intres : smallint;
|
||||
byteboolval : bytebool;
|
||||
wordboolval : wordbool;
|
||||
longboolval : longbool;
|
||||
byteboolres : bytebool;
|
||||
wordboolres : wordbool;
|
||||
longboolres : longbool;
|
||||
{$ifdef fpc}
|
||||
int64res : int64;
|
||||
qwordres : qword;
|
||||
{$endif}
|
||||
Begin
|
||||
WriteLn('------------------------------ LONGINT --------------------------------');
|
||||
{ CURRENT NODE: REGISTER }
|
||||
{ LEFT NODE : REFERENCE }
|
||||
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
|
||||
longres := $7F7F7F7F;
|
||||
longres := -longres;
|
||||
Write('Value should be $80808081...');
|
||||
|
||||
{ the following test give range check errors }
|
||||
test(longres,longint($80808081));
|
||||
|
||||
{ CURRENT NODE : REGISTER }
|
||||
{ LEFT NODE : REGISTER }
|
||||
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
|
||||
longres := - getintres;
|
||||
Write('Value should be $FFFF8081...');
|
||||
test(longres, longint($FFFF8081));
|
||||
|
||||
|
||||
Writeln('Overflow tests');
|
||||
Write('-0...');
|
||||
longres:=0;
|
||||
longres:=-longres;
|
||||
test(longres,0);
|
||||
longres:=high(longint);
|
||||
longres:=-longres;
|
||||
Write('-',high(longint),'...');
|
||||
test(longres,longint($80000001));
|
||||
|
||||
Write('-(',low(longint),')...');
|
||||
longres:=low(longint);
|
||||
caught:=false;
|
||||
try
|
||||
longres:=-longres;
|
||||
except
|
||||
{$ifdef cpu64}
|
||||
on erangeerror do
|
||||
{$else cpu64}
|
||||
on eintoverflow do
|
||||
{$endif cpu64}
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Overflow -$80000000 not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
|
||||
|
||||
WriteLn('------------------------------ CARDINAL ----------------------------------');
|
||||
|
||||
Writeln('Overflow/Rangecheck tests');
|
||||
Write('-0...');
|
||||
cardres:=0;
|
||||
longres:=-cardres;
|
||||
test(longres,0);
|
||||
cardres:=high(longint);
|
||||
longres:=-cardres;
|
||||
Write('-',high(longint),'...');
|
||||
test(longres,longint($80000001));
|
||||
|
||||
Write('-',high(cardinal),'...');
|
||||
cardres:=high(cardinal);
|
||||
caught:=false;
|
||||
try
|
||||
longres:=-cardres;
|
||||
except
|
||||
on erangeerror do
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Rangecheck -high(cardinal) not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
|
||||
{$ifndef cpu64}
|
||||
{ this is calculated in 64 bit on 64 bit cpus -> no range error }
|
||||
|
||||
Write('-',cardinal($80000000),'...');
|
||||
cardres:=cardinal($80000000);
|
||||
caught:=false;
|
||||
try
|
||||
longres:=-cardres;
|
||||
except
|
||||
on erangeerror do
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Rangecheck -cardinal($80000000) not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
{$endif cpu64}
|
||||
|
||||
{$IFDEF FPC}
|
||||
WriteLn('------------------------------ INT64 ----------------------------------');
|
||||
{ CURRENT NODE: REGISTER }
|
||||
{ LEFT NODE : REFERENCE }
|
||||
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REFERENCE');
|
||||
int64res := $7F7F7F7F;
|
||||
int64res := - int64res;
|
||||
Write('Value should be $80808081...');
|
||||
test(longint(int64res and $FFFFFFFF),longint($80808081));
|
||||
|
||||
{ CURRENT NODE : REGISTER }
|
||||
{ LEFT NODE : REGISTER }
|
||||
WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER');
|
||||
int64res := - (word(getintres));
|
||||
Write('Value should be $8081...');
|
||||
test(longint(int64res and $FFFFFFFF),longint($FFFF8081));
|
||||
|
||||
Writeln('Overflow tests');
|
||||
Write('-0...');
|
||||
int64res:=0;
|
||||
int64res:=-int64res;
|
||||
test(hi(int64res) or lo(int64res),0);
|
||||
int64res:=high(int64);
|
||||
int64res:=-int64res;
|
||||
Write('-',high(int64),'... (2 tests)');
|
||||
test(longint(hi(int64res)),longint($80000000));
|
||||
test(longint(lo(int64res)),1);
|
||||
|
||||
Writeln('-(',low(int64),')...');
|
||||
int64res:=low(int64);
|
||||
caught:=false;
|
||||
try
|
||||
int64res:=-int64res;
|
||||
except
|
||||
on eintoverflow do
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Overflow -$8000000000000000 not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
|
||||
|
||||
WriteLn('------------------------------ QWORD ----------------------------------');
|
||||
|
||||
Writeln('Overflow/Rangecheck tests');
|
||||
Write('-0...');
|
||||
qwordres:=0;
|
||||
int64res:=-qwordres;
|
||||
test(hi(int64res) or lo(int64res),0);
|
||||
qwordres:=high(int64);
|
||||
int64res:=-qwordres;
|
||||
Write('-',high(int64),'... (2 tests)');
|
||||
test(longint(hi(int64res)),longint($80000000));
|
||||
test(longint(lo(int64res)),1);
|
||||
|
||||
Write('-',high(qword),'...');
|
||||
qwordres:=high(qword);
|
||||
caught:=false;
|
||||
try
|
||||
int64res:=-qwordres;
|
||||
except
|
||||
on erangeerror do
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Rangecheck -high(qword) not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
|
||||
Write('-',qword($8000000000000000),'...');
|
||||
qwordres:=qword($8000000000000000);
|
||||
caught:=false;
|
||||
try
|
||||
int64res:=-qwordres;
|
||||
except
|
||||
on erangeerror do
|
||||
caught:=true;
|
||||
end;
|
||||
if not caught then
|
||||
begin
|
||||
Writeln('Rangecheck -qword($8000000000000000) not caught');
|
||||
halt(1);
|
||||
end
|
||||
else
|
||||
writeln('Passed!');
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user