diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index 1dc9bd33e8..0b212d05ae 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -71,6 +71,8 @@ interface end; tcgvecnode = class(tvecnode) + private + procedure rangecheck_array; protected function get_mul_size : aword; procedure update_reference_reg_mul(reg:tregister;l:aword);virtual; @@ -515,19 +517,69 @@ implementation begin end; + + procedure tcgvecnode.rangecheck_array; + var + freereg : boolean; + hightree : tnode; + srsym : tsym; + poslabel, + neglabel : tasmlabel; + hreg : tregister; + begin + if is_open_array(left.resulttype.def) or + is_array_of_const(left.resulttype.def) then + begin + { Get high value } + srsym:=searchsymonlyin(tloadnode(left).symtable, + 'high'+tvarsym(tloadnode(left).symtableentry).name); + hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable); + firstpass(hightree); + secondpass(hightree); + { generate compares } + freereg:=false; + if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + hreg:=right.location.register + else + begin + hreg := cg.get_scratch_reg_int(exprasmlist); + freereg:=true; + cg.a_load_loc_reg(exprasmlist,right.location,hreg); + end; + objectlibrary.getlabel(neglabel); + 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_call_name(exprasmlist,'FPC_RANGEERROR'); + cg.a_label(exprasmlist,neglabel); + { release hightree } + location_release(exprasmlist,hightree.location); + hightree.free; + end + else + if is_dynamic_array(left.resulttype.def) then + begin +{$ifdef fpc} + {$warning Rangecheck for dynamic array} +{$endif fpc} + internalerror(200210074); + end + else + cg.g_rangecheck(exprasmlist,right,left.resulttype.def); + end; + + procedure tcgvecnode.pass_2; var extraoffset : longint; - { rl stores the resulttype.def of the left node, this is necessary } - { to detect if it is an ansistring } - { because in constant nodes which constant index } - { the left tree is removed } - t : tnode; + t : tnode; href : treference; - srsym : tsym; pushed : tpushedsaved; - hightree : tnode; isjump : boolean; otl,ofl : tasmlabel; newsize : tcgsize; @@ -654,11 +706,10 @@ implementation end else begin - { range checking for open and dynamic arrays !!!! } -{$ifdef fpc} -{$warning FIXME} -{$endif} - {!!!!!!!!!!!!!!!!!} + { range checking for open and dynamic arrays needs + runtime code } + secondpass(right); + rangecheck_array; end; end; stringdef : @@ -781,24 +832,7 @@ implementation if cs_check_range in aktlocalswitches then begin if left.resulttype.def.deftype=arraydef then - begin - if is_open_array(left.resulttype.def) or - is_array_of_const(left.resulttype.def) then - begin - tarraydef(left.resulttype.def).genrangecheck; - srsym:=searchsymonlyin(tloadnode(left).symtable, - 'high'+tvarsym(tloadnode(left).symtableentry).name); - hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable); - firstpass(hightree); - secondpass(hightree); - location_release(exprasmlist,hightree.location); - reference_reset_symbol(href,objectlibrary.newasmsymbol(tarraydef(left.resulttype.def).getrangecheckstring),4); - cg.a_load_loc_ref(exprasmlist,hightree.location,href); - hightree.free; - hightree:=nil; - end; - cg.g_rangecheck(exprasmlist,right,left.resulttype.def); - end; + rangecheck_array; end; location_force_reg(exprasmlist,right.location,OS_32,false); @@ -868,7 +902,10 @@ begin end. { $Log$ - Revision 1.29 2002-10-05 12:43:25 carl + 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 * fixes for Delphi 6 compilation (warning : Some features do not work under Delphi)