mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 23:19:24 +02:00
+ WebAssembly implementation of g_rangecheck that uses if/endif instead of
jumps to labels (which causes internal compiler error, because they're not supported in WebAssembly) git-svn-id: trunk@49000 -
This commit is contained in:
nickysn
parent
3072df59ff
commit
ecad5e9a6c
@ -102,6 +102,8 @@ uses
|
||||
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
|
||||
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
|
||||
|
||||
procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override;
|
||||
|
||||
procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
|
||||
procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
|
||||
|
||||
@ -1471,6 +1473,222 @@ implementation
|
||||
list.concat(taicpu.op_none(a_end_function));
|
||||
end;
|
||||
|
||||
procedure thlcgwasm.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
|
||||
var
|
||||
{$if defined(cpuhighleveltarget)}
|
||||
aintmax: tcgint;
|
||||
{$elseif defined(cpu64bitalu) or defined(cpu32bitalu)}
|
||||
aintmax: aint;
|
||||
{$else}
|
||||
aintmax: longint;
|
||||
{$endif}
|
||||
//neglabel : tasmlabel;
|
||||
//hreg : tregister;
|
||||
lto,hto,
|
||||
lfrom,hfrom : TConstExprInt;
|
||||
fromsize, tosize: cardinal;
|
||||
maxdef: tdef;
|
||||
from_signed, to_signed: boolean;
|
||||
begin
|
||||
{ range checking on and range checkable value? }
|
||||
if not(cs_check_range in current_settings.localswitches) or
|
||||
not(fromdef.typ in [orddef,enumdef]) or
|
||||
{ C-style booleans can't really fail range checks, }
|
||||
{ all values are always valid }
|
||||
is_cbool(todef) then
|
||||
exit;
|
||||
{$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
|
||||
{ handle 64bit rangechecks separate for 32bit processors }
|
||||
if is_64bit(fromdef) or is_64bit(todef) then
|
||||
begin
|
||||
cg64.g_rangecheck64(list,l,fromdef,todef);
|
||||
exit;
|
||||
end;
|
||||
{$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
|
||||
{ only check when assigning to scalar, subranges are different, }
|
||||
{ when todef=fromdef then the check is always generated }
|
||||
getrange(fromdef,lfrom,hfrom);
|
||||
getrange(todef,lto,hto);
|
||||
from_signed := is_signed(fromdef);
|
||||
to_signed := is_signed(todef);
|
||||
{ check the rangedef of the array, not the array itself }
|
||||
{ (only change now, since getrange needs the arraydef) }
|
||||
if (todef.typ = arraydef) then
|
||||
todef := tarraydef(todef).rangedef;
|
||||
{ no range check if from and to are equal and are both longint/dword }
|
||||
{ (if we have a 32bit processor) or int64/qword, since such }
|
||||
{ operations can at most cause overflows (JM) }
|
||||
{ Note that these checks are mostly processor independent, they only }
|
||||
{ have to be changed once we introduce 64bit subrange types }
|
||||
{$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
|
||||
if (fromdef=todef) and
|
||||
(fromdef.typ=orddef) and
|
||||
(((((torddef(fromdef).ordtype=s64bit) and
|
||||
(lfrom = low(int64)) and
|
||||
(hfrom = high(int64))) or
|
||||
((torddef(fromdef).ordtype=u64bit) and
|
||||
(lfrom = low(qword)) and
|
||||
(hfrom = high(qword))) or
|
||||
((torddef(fromdef).ordtype=scurrency) and
|
||||
(lfrom = low(int64)) and
|
||||
(hfrom = high(int64)))))) then
|
||||
exit;
|
||||
{$endif cpuhighleveltarget or cpu64bitalu}
|
||||
{ 32 bit operations are automatically widened to 64 bit on 64 bit addr
|
||||
targets }
|
||||
{$ifdef cpu32bitaddr}
|
||||
if (fromdef = todef) and
|
||||
(fromdef.typ=orddef) and
|
||||
(((((torddef(fromdef).ordtype = s32bit) and
|
||||
(lfrom = int64(low(longint))) and
|
||||
(hfrom = int64(high(longint)))) or
|
||||
((torddef(fromdef).ordtype = u32bit) and
|
||||
(lfrom = low(cardinal)) and
|
||||
(hfrom = high(cardinal)))))) then
|
||||
exit;
|
||||
{$endif cpu32bitaddr}
|
||||
|
||||
{ optimize some range checks away in safe cases }
|
||||
fromsize := fromdef.size;
|
||||
tosize := todef.size;
|
||||
if ((from_signed = to_signed) or
|
||||
(not from_signed)) and
|
||||
(lto<=lfrom) and (hto>=hfrom) and
|
||||
(fromsize <= tosize) then
|
||||
begin
|
||||
{ if fromsize < tosize, and both have the same signed-ness or }
|
||||
{ fromdef is unsigned, then all bit patterns from fromdef are }
|
||||
{ valid for todef as well }
|
||||
if (fromsize < tosize) then
|
||||
exit;
|
||||
if (fromsize = tosize) and
|
||||
(from_signed = to_signed) then
|
||||
{ only optimize away if all bit patterns which fit in fromsize }
|
||||
{ are valid for the todef }
|
||||
begin
|
||||
{$ifopt Q+}
|
||||
{$define overflowon}
|
||||
{$Q-}
|
||||
{$endif}
|
||||
{$ifopt R+}
|
||||
{$define rangeon}
|
||||
{$R-}
|
||||
{$endif}
|
||||
if to_signed then
|
||||
begin
|
||||
{ calculation of the low/high ranges must not overflow 64 bit
|
||||
otherwise we end up comparing with zero for 64 bit data types on
|
||||
64 bit processors }
|
||||
if (lto = (int64(-1) << (tosize * 8 - 1))) and
|
||||
(hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
|
||||
exit
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ calculation of the low/high ranges must not overflow 64 bit
|
||||
otherwise we end up having all zeros for 64 bit data types on
|
||||
64 bit processors }
|
||||
if (lto = 0) and
|
||||
(qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
|
||||
exit
|
||||
end;
|
||||
{$ifdef overflowon}
|
||||
{$Q+}
|
||||
{$undef overflowon}
|
||||
{$endif}
|
||||
{$ifdef rangeon}
|
||||
{$R+}
|
||||
{$undef rangeon}
|
||||
{$endif}
|
||||
end
|
||||
end;
|
||||
|
||||
{ depending on the types involved, we perform the range check for 64 or
|
||||
for 32 bit }
|
||||
if fromsize=8 then
|
||||
maxdef:=fromdef
|
||||
else
|
||||
maxdef:=todef;
|
||||
{$if sizeof(aintmax) = 8}
|
||||
if maxdef.size=8 then
|
||||
aintmax:=high(int64)
|
||||
else
|
||||
{$endif}
|
||||
begin
|
||||
aintmax:=high(longint);
|
||||
maxdef:=u32inttype;
|
||||
end;
|
||||
|
||||
{ generate the rangecheck code for the def where we are going to }
|
||||
{ store the result }
|
||||
|
||||
{ use the trick that }
|
||||
{ a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
|
||||
|
||||
{ To be able to do that, we have to make sure however that either }
|
||||
{ fromdef and todef are both signed or unsigned, or that we leave }
|
||||
{ the parts < 0 and > maxlongint out }
|
||||
|
||||
if from_signed xor to_signed then
|
||||
begin
|
||||
if from_signed then
|
||||
{ from is signed, to is unsigned }
|
||||
begin
|
||||
{ if high(from) < 0 -> always range error }
|
||||
if (hfrom < 0) or
|
||||
{ if low(to) > maxlongint also range error }
|
||||
(lto > aintmax) then
|
||||
begin
|
||||
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
|
||||
exit
|
||||
end;
|
||||
{ from is signed and to is unsigned -> when looking at to }
|
||||
{ as an signed value, it must be < maxaint (otherwise }
|
||||
{ it will become negative, which is invalid since "to" is unsigned) }
|
||||
if hto > aintmax then
|
||||
hto := aintmax;
|
||||
end
|
||||
else
|
||||
{ from is unsigned, to is signed }
|
||||
begin
|
||||
if (lfrom > aintmax) or
|
||||
(hto < 0) then
|
||||
begin
|
||||
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
|
||||
exit
|
||||
end;
|
||||
{ from is unsigned and to is signed -> when looking at to }
|
||||
{ as an unsigned value, it must be >= 0 (since negative }
|
||||
{ values are the same as values > maxlongint) }
|
||||
if lto < 0 then
|
||||
lto := 0;
|
||||
end;
|
||||
end;
|
||||
a_load_loc_stack(list,fromdef,l);
|
||||
resize_stack_int_val(list,fromdef,maxdef,false);
|
||||
a_load_const_stack(list,maxdef,tcgint(int64(lto)),R_INTREGISTER);
|
||||
a_op_stack(list,OP_SUB,maxdef);
|
||||
{
|
||||
if from_signed then
|
||||
a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
|
||||
else
|
||||
}
|
||||
if qword(hto-lto)>qword(aintmax) then
|
||||
a_load_const_stack(list,maxdef,aintmax,R_INTREGISTER)
|
||||
else
|
||||
a_load_const_stack(list,maxdef,tcgint(int64(hto-lto)),R_INTREGISTER);
|
||||
a_cmp_stack_stack(list,maxdef,OC_A);
|
||||
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
|
||||
thlcgwasm(hlcg).incblock;
|
||||
thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
|
||||
|
||||
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
|
||||
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
|
||||
thlcgwasm(hlcg).decblock;
|
||||
end;
|
||||
|
||||
procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
|
||||
begin
|
||||
{ not possible, need the original operands }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user