Forráskód Böngészése

* fixed issue #6977 (add regvars occupied by the invisible high parameter
of "open array" and "array of const" parameters to the used regvars
for their array accesses if range checking is turned on)

git-svn-id: trunk@3914 -

Jonas Maebe 19 éve
szülő
commit
df973fa1de
5 módosított fájl, 75 hozzáadás és 4 törlés
  1. 1 0
      .gitattributes
  2. 1 0
      compiler/ncgmem.pas
  3. 9 1
      compiler/ncgutil.pas
  4. 10 3
      compiler/nutils.pas
  5. 54 0
      tests/webtbs/tw6977.pp

+ 1 - 0
.gitattributes

@@ -7191,6 +7191,7 @@ tests/webtbs/tw6735.pp svneol=native#text/plain
 tests/webtbs/tw6742.pp svneol=native#text/plain
 tests/webtbs/tw6742.pp svneol=native#text/plain
 tests/webtbs/tw6767.pp svneol=native#text/plain
 tests/webtbs/tw6767.pp svneol=native#text/plain
 tests/webtbs/tw6960.pp svneol=native#text/plain
 tests/webtbs/tw6960.pp svneol=native#text/plain
+tests/webtbs/tw6977.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/tw7006.pp svneol=native#text/plain
 tests/webtbs/tw7006.pp svneol=native#text/plain

+ 1 - 0
compiler/ncgmem.pas

@@ -646,6 +646,7 @@ implementation
                          st_shortstring:
                          st_shortstring:
                            begin
                            begin
                               {!!!!!!!!!!!!!!!!!}
                               {!!!!!!!!!!!!!!!!!}
+                              { if this one is implemented making use of the high parameter for openshortstrings, update ncgutils.do_get_used_regvars() too (JM) }
                            end;
                            end;
 
 
                          st_longstring:
                          st_longstring:

+ 9 - 1
compiler/ncgutil.pas

@@ -162,7 +162,7 @@ implementation
     procinfo,paramgr,fmodule,
     procinfo,paramgr,fmodule,
     regvars,dbgbase,
     regvars,dbgbase,
     pass_1,pass_2,
     pass_1,pass_2,
-    nbas,ncon,nld,nutils,
+    nbas,ncon,nld,nmem,nutils,
     tgobj,cgobj
     tgobj,cgobj
 {$ifdef powerpc}
 {$ifdef powerpc}
     , cpupi
     , cpupi
@@ -2207,6 +2207,14 @@ implementation
           loadn:
           loadn:
             if (tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
             if (tloadnode(n).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) then
               add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
               add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
+          vecn:
+            { range checks sometimes need the high parameter }
+            if (cs_check_range in aktlocalswitches) and
+               (is_open_array(tvecnode(n).left.resulttype.def) or
+                is_array_of_const(tvecnode(n).left.resulttype.def)) and
+               not(current_procinfo.procdef.proccalloption in [pocall_cdecl,pocall_cppdecl]) then
+              add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc)
+
         end;
         end;
         result := fen_true;
         result := fen_true;
       end;
       end;

+ 10 - 3
compiler/nutils.pas

@@ -27,7 +27,7 @@ interface
 
 
   uses
   uses
     globals,
     globals,
-    symsym,node;
+    symtype,symsym,node;
 
 
   const
   const
     NODE_COMPLEXITY_INF = 255;
     NODE_COMPLEXITY_INF = 255;
@@ -57,6 +57,7 @@ interface
 
 
     procedure load_procvar_from_calln(var p1:tnode);
     procedure load_procvar_from_calln(var p1:tnode);
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
+    function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file }
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_self_node:tnode;
     function load_self_node:tnode;
     function load_result_node:tnode;
     function load_result_node:tnode;
@@ -79,7 +80,7 @@ implementation
 
 
     uses
     uses
       globtype,verbose,
       globtype,verbose,
-      symconst,symbase,symtype,symdef,symtable,
+      symconst,symbase,symdef,symtable,
       defutil,defcmp,
       defutil,defcmp,
       nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,
       nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,
       cgbase,procinfo,
       cgbase,procinfo,
@@ -275,12 +276,18 @@ implementation
       end;
       end;
 
 
 
 
+    function get_high_value_sym(vs: tparavarsym):tsym;
+      begin
+        result := tsym(vs.owner.search('high'+vs.name));
+      end;
+
+
     function load_high_value_node(vs:tparavarsym):tnode;
     function load_high_value_node(vs:tparavarsym):tnode;
       var
       var
         srsym : tsym;
         srsym : tsym;
       begin
       begin
         result:=nil;
         result:=nil;
-        srsym:=tsym(vs.owner.search('high'+vs.name));
+        srsym:=get_high_value_sym(vs);
         if assigned(srsym) then
         if assigned(srsym) then
           begin
           begin
             result:=cloadnode.create(srsym,vs.owner);
             result:=cloadnode.create(srsym,vs.owner);

+ 54 - 0
tests/webtbs/tw6977.pp

@@ -0,0 +1,54 @@
+program bug1;
+
+{$mode objfpc}{$H+}
+{$r+}
+
+uses Classes;
+
+type
+
+  TCTEntry = record
+    Name: AnsiString;
+    g: Integer;
+  end;
+
+  TCT = record
+    Size: Integer;
+    Names: array of PChar;
+    IReps: array of TCTEntry;
+  end;
+
+
+const
+
+  C: array [0..2] of TCTEntry =
+  ((Name:'A'; g:0),
+   (Name:'B'; g:0),
+   (Name:'C'; g:1));
+
+
+var
+  CTs: array [0..1] of TCT;
+  p: Integer;
+
+  procedure A(T: array of TCTEntry);
+  var
+    i: Integer;
+  begin
+    with CTs[p] do begin
+      Size := Length(T);
+      Setlength(IReps, Size);
+      Setlength(Names, Size+1);
+      Names[Size] := nil;
+      for i := 0 to Size-1 do begin
+        Names[i] := PChar(T[i].Name);
+        IReps[i] := T[i];
+      end;
+    end;
+  end;
+
+begin
+  p := 0;
+  A(C);
+end.
+