mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 19:43:15 +01:00
+ range checking for dyn. arrays
This commit is contained in:
parent
1de5ae84d3
commit
b38887e311
@ -526,6 +526,8 @@ implementation
|
||||
poslabel,
|
||||
neglabel : tasmlabel;
|
||||
hreg : tregister;
|
||||
href : treference;
|
||||
pushed : tpushedsaved;
|
||||
begin
|
||||
if is_open_array(left.resulttype.def) or
|
||||
is_array_of_const(left.resulttype.def) then
|
||||
@ -550,10 +552,9 @@ implementation
|
||||
objectlibrary.getlabel(poslabel);
|
||||
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_LT,0,hreg,poslabel);
|
||||
cg.a_cmp_loc_reg_label(exprasmlist,OS_INT,OC_BE,hightree.location,hreg,neglabel);
|
||||
cg.a_label(exprasmlist,poslabel);
|
||||
{ !!! should happen right after the compare (JM) }
|
||||
if freereg then
|
||||
cg.free_scratch_reg(exprasmlist,hreg);
|
||||
cg.a_label(exprasmlist,poslabel);
|
||||
cg.a_call_name(exprasmlist,'FPC_RANGEERROR');
|
||||
cg.a_label(exprasmlist,neglabel);
|
||||
{ release hightree }
|
||||
@ -562,12 +563,15 @@ implementation
|
||||
end
|
||||
else
|
||||
if is_dynamic_array(left.resulttype.def) then
|
||||
begin
|
||||
{$ifdef fpc}
|
||||
{$warning Rangecheck for dynamic array}
|
||||
{$endif fpc}
|
||||
internalerror(200210074);
|
||||
end
|
||||
begin
|
||||
rg.saveusedregisters(exprasmlist,pushed,all_registers);
|
||||
cg.a_param_loc(exprasmlist,right.location,paramanager.getintparaloc(2));
|
||||
cg.a_param_loc(exprasmlist,left.location,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_DYNARRAY_RANGECHECK');
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
end
|
||||
else
|
||||
cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
|
||||
end;
|
||||
@ -644,7 +648,6 @@ implementation
|
||||
dec(location.reference.offset,2);
|
||||
end
|
||||
else if is_dynamic_array(left.resulttype.def) then
|
||||
{ ... also a dynamic string }
|
||||
begin
|
||||
case left.location.loc of
|
||||
LOC_REGISTER,
|
||||
@ -661,20 +664,6 @@ implementation
|
||||
else
|
||||
internalerror(2002032219);
|
||||
end;
|
||||
{$ifdef fpc}
|
||||
{$warning FIXME}
|
||||
{$endif}
|
||||
{ check for a zero length string,
|
||||
we can use the ansistring routine here }
|
||||
if (cs_check_range in aktlocalswitches) then
|
||||
begin
|
||||
rg.saveusedregisters(exprasmlist,pushed,all_registers);
|
||||
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
|
||||
rg.saveregvars(exprasmlist,all_registers);
|
||||
cg.a_call_name(exprasmlist,'FPC_ANSISTR_CHECKZERO');
|
||||
cg.g_maybe_loadself(exprasmlist);
|
||||
rg.restoreusedregisters(exprasmlist,pushed);
|
||||
end;
|
||||
end
|
||||
else
|
||||
location_copy(location,left.location);
|
||||
@ -824,10 +813,6 @@ implementation
|
||||
maybe_save(exprasmlist,right.registers32,location,pushedregs);
|
||||
secondpass(right);
|
||||
maybe_restore(exprasmlist,location,pushedregs);
|
||||
{ here we change the location of right
|
||||
and the update was forgotten so it
|
||||
led to wrong code in emitrangecheck later PM
|
||||
so make range check before }
|
||||
|
||||
if cs_check_range in aktlocalswitches then
|
||||
begin
|
||||
@ -902,7 +887,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.30 2002-10-07 21:30:45 peter
|
||||
Revision 1.31 2002-10-09 20:24:47 florian
|
||||
+ range checking for dyn. arrays
|
||||
|
||||
Revision 1.30 2002/10/07 21:30:45 peter
|
||||
* rangecheck for open arrays added
|
||||
|
||||
Revision 1.29 2002/10/05 12:43:25 carl
|
||||
|
||||
@ -34,6 +34,12 @@ type
|
||||
eletype : pdynarraytypeinfo;
|
||||
end;
|
||||
|
||||
function fpc_dynarray_rangecheck(p : pointer;i : tdynarrayindex) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_RANGECHECK']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
begin
|
||||
if not(assigned(p)) or (i<0) or (i>pdynarray(p-sizeof(tdynarray))^.high) then
|
||||
HandleErrorFrame(201,get_frame);
|
||||
end;
|
||||
|
||||
|
||||
function fpc_dynarray_length(p : pointer) : tdynarrayindex;[Public,Alias:'FPC_DYNARRAY_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
||||
begin
|
||||
@ -268,7 +274,10 @@ procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);{$i
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 2002-10-02 18:21:51 peter
|
||||
Revision 1.20 2002-10-09 20:24:30 florian
|
||||
+ range checking for dyn. arrays
|
||||
|
||||
Revision 1.19 2002/10/02 18:21:51 peter
|
||||
* Copy() changed to internal function calling compilerprocs
|
||||
* FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
|
||||
new copy functions
|
||||
@ -286,5 +295,4 @@ procedure fpc_dynarray_copy(var pdest : pointer;psrc : pointer;ti : pointer);{$i
|
||||
|
||||
Revision 1.15 2002/01/21 20:16:08 peter
|
||||
* updated for dynarr:=nil
|
||||
|
||||
}
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user