|
|
@@ -451,17 +451,6 @@ unit cgobj;
|
|
|
procedure g_initialize(list : TAsmList;t : tdef;const ref : treference);
|
|
|
procedure g_finalize(list : TAsmList;t : tdef;const ref : treference);
|
|
|
|
|
|
- {# Generates range checking code. It is to note
|
|
|
- that this routine does not need to be overridden,
|
|
|
- as it takes care of everything.
|
|
|
-
|
|
|
- @param(p Node which contains the value to check)
|
|
|
- @param(todef Type definition of node to range check)
|
|
|
- }
|
|
|
- { only left here because used by cg64f32; normally, the code in
|
|
|
- hlcgobj is used }
|
|
|
- procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); virtual;
|
|
|
-
|
|
|
{# Generates overflow checking code for a node }
|
|
|
procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract;
|
|
|
procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual;
|
|
|
@@ -3693,184 +3682,6 @@ implementation
|
|
|
end;
|
|
|
|
|
|
|
|
|
- procedure tcg.g_rangecheck(list: TAsmList; const l:tlocation;fromdef,todef: tdef);
|
|
|
- { generate range checking code for the value at location p. The type }
|
|
|
- { type used is checked against todefs ranges. fromdef (p.resultdef) }
|
|
|
- { is the original type used at that location. When both defs are equal }
|
|
|
- { the check is also insert (needed for succ,pref,inc,dec) }
|
|
|
- const
|
|
|
- aintmax=high(aint);
|
|
|
- var
|
|
|
- neglabel : tasmlabel;
|
|
|
- hreg : tregister;
|
|
|
- lto,hto,
|
|
|
- lfrom,hfrom : TConstExprInt;
|
|
|
- fromsize, tosize: cardinal;
|
|
|
- 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;
|
|
|
-{$ifndef 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 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 }
|
|
|
-{$ifdef 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;
|
|
|
-{$else cpu64bitalu}
|
|
|
- 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 cpu64bitalu}
|
|
|
-
|
|
|
- { 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
|
|
|
-{$push}
|
|
|
-{$Q-}
|
|
|
-{$R-}
|
|
|
- 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;
|
|
|
-{$pop}
|
|
|
- end
|
|
|
- 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
|
|
|
- a_call_name(list,'FPC_RANGEERROR',false);
|
|
|
- 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
|
|
|
- a_call_name(list,'FPC_RANGEERROR',false);
|
|
|
- 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;
|
|
|
- hreg:=getintregister(list,OS_INT);
|
|
|
- a_load_loc_reg(list,OS_INT,l,hreg);
|
|
|
- a_op_const_reg(list,OP_SUB,OS_INT,tcgint(int64(lto)),hreg);
|
|
|
- current_asmdata.getjumplabel(neglabel);
|
|
|
- {
|
|
|
- if from_signed then
|
|
|
- a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
|
|
|
- else
|
|
|
- }
|
|
|
-{$ifdef cpu64bitalu}
|
|
|
- if qword(hto-lto)>qword(aintmax) then
|
|
|
- a_cmp_const_reg_label(list,OS_INT,OC_BE,aintmax,hreg,neglabel)
|
|
|
- else
|
|
|
-{$endif cpu64bitalu}
|
|
|
- a_cmp_const_reg_label(list,OS_INT,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel);
|
|
|
- a_call_name(list,'FPC_RANGEERROR',false);
|
|
|
- a_label(list,neglabel);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
procedure tcg.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);
|
|
|
begin
|
|
|
g_overflowCheck(list,loc,def);
|
Jonas Maebe