Browse Source

Merge of trunk commits 39983,39986,40109
------------------------------------------------------------------------
r39983 | florian | 2018-10-18 20:28:03 +0200 (Thu, 18 Oct 2018) | 3 lines

* properly take care of register allocations between the first and second instruction for the FoldLea optimization
* check for ait_instruction after a GetNextInstruction function call
* cosmetics
------------------------------------------------------------------------
------------------------------------------------------------------------
r39986 | pierre | 2018-10-18 22:21:54 +0200 (Thu, 18 Oct 2018) | 1 line

Fix for bug report #34380
------------------------------------------------------------------------
------------------------------------------------------------------------
r40109 | pierre | 2018-10-31 15:43:18 +0100 (Wed, 31 Oct 2018) | 1 line

Use correct field for sl_absolutetype or sl_typeconv ppropaccesslistitem type (revealed by compilation with -CriotR)
------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@40482 -

pierre 6 years ago
parent
commit
36f9ce1cb2

+ 1 - 0
.gitattributes

@@ -16260,6 +16260,7 @@ tests/webtbs/tw34287.pp svneol=native#text/pascal
 tests/webtbs/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.pp svneol=native#text/plain
+tests/webtbs/tw34380.pp svneol=native#text/plain
 tests/webtbs/tw3441.pp svneol=native#text/plain
 tests/webtbs/tw3443.pp svneol=native#text/plain
 tests/webtbs/tw3444.pp svneol=native#text/plain

+ 5 - 0
compiler/aarch64/cpubase.pas

@@ -325,6 +325,7 @@ unit cpubase;
     procedure shifterop_reset(var so : tshifterop); {$ifdef USEINLINE}inline;{$endif USEINLINE}
 
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
     function is_shifter_const(d: aint; size: tcgsize): boolean;
 
@@ -490,6 +491,10 @@ unit cpubase;
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 
     function is_shifter_const(d: aint; size: tcgsize): boolean;
       var

+ 6 - 0
compiler/arm/cpubase.pas

@@ -379,6 +379,7 @@ unit cpubase;
     function split_into_shifter_const(value : aint;var imm1: dword; var imm2: dword):boolean;
     function is_continuous_mask(d : aint;var lsb, width: byte) : boolean;
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
     function IsIT(op: TAsmOp) : boolean;
     function GetITLevels(op: TAsmOp) : longint;
@@ -654,6 +655,11 @@ unit cpubase;
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
+
       { Low part of 64bit return value }
     function NR_FUNCTION_RESULT64_LOW_REG: tregister; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     begin

+ 5 - 0
compiler/avr/cpubase.pas

@@ -304,6 +304,7 @@ unit cpubase;
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
 
     function dwarf_reg(r:tregister):byte;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
 
@@ -426,6 +427,10 @@ unit cpubase;
         result:=reg;
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 
     function is_calljmp(o:tasmop):boolean;{$ifdef USEINLINE}inline;{$endif USEINLINE}
       begin

+ 10 - 6
compiler/dbgdwarf.pas

@@ -2487,7 +2487,7 @@ implementation
             sl_absolutetype,
             sl_typeconv:
               begin
-                currdef:=tfieldvarsym(symlist^.sym).vardef;
+                currdef:=symlist^.def;
                 { ignore, these don't change the address }
               end;
             sl_vec:
@@ -2534,7 +2534,7 @@ implementation
         blocksize,size_of_int : longint;
         tag : tdwarf_tag;
         has_high_reg : boolean;
-        dreg,dreghigh : byte;
+        dreg,dreghigh : shortint;
 {$ifdef i8086}
         has_segment_sym_name : boolean=false;
         segment_sym_name : TSymStr='';
@@ -2565,15 +2565,19 @@ implementation
           LOC_FPUREGISTER,
           LOC_CFPUREGISTER :
             begin
-              dreg:=dwarf_reg(sym.localloc.register);
+              { dwarf_reg_no_error might return -1
+                in case the register variable has been optimized out }
+              dreg:=dwarf_reg_no_error(sym.localloc.register);
               has_high_reg:=(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and (sym.localloc.registerhi<>NR_NO);
               if has_high_reg then
-                dreghigh:=dwarf_reg(sym.localloc.registerhi);
+                dreghigh:=dwarf_reg_no_error(sym.localloc.registerhi);
+              if dreghigh=-1 then
+                has_high_reg:=false;
               if (sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) and
                  (sym.typ=paravarsym) and
                   paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
                   not(vo_has_local_copy in sym.varoptions) and
-                  not is_open_string(sym.vardef) then
+                  not is_open_string(sym.vardef) and (dreg>=0) then
                 begin
                   templist.concat(tai_const.create_8bit(ord(DW_OP_bregx)));
                   templist.concat(tai_const.create_uleb128bit(dreg));
@@ -2599,7 +2603,7 @@ implementation
                       templist.concat(tai_const.create_uleb128bit(size_of_int));
                       blocksize:=blocksize+1+Lengthuleb128(size_of_int);
                     end
-                  else
+                  else if (dreg>=0) then
                     begin
                       templist.concat(tai_const.create_8bit(ord(DW_OP_regx)));
                       templist.concat(tai_const.create_uleb128bit(dreg));

+ 5 - 0
compiler/m68k/cpubase.pas

@@ -369,6 +369,7 @@ unit cpubase;
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
     function isvalue8bit(val: tcgint): boolean;
     function isvalue16bit(val: tcgint): boolean;
@@ -594,6 +595,10 @@ implementation
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 
     { returns true if given value fits to an 8bit signed integer }
     function isvalue8bit(val: tcgint): boolean;

+ 11 - 0
compiler/mips/cpubase.pas

@@ -270,6 +270,7 @@ unit cpubase;
     function std_regnum_search(const s:string):Tregister;
     function std_regname(r:Tregister):string;
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
   implementation
 
@@ -406,5 +407,15 @@ unit cpubase;
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        case getsubreg(r) of
+          R_SUBFD:
+            setsubreg(r, R_SUBFS);
+          R_SUBL, R_SUBW, R_SUBD, R_SUBQ:
+            setsubreg(r, R_SUBD);
+        end;
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 begin
 end.

+ 5 - 0
compiler/powerpc/cpubase.pas

@@ -397,6 +397,7 @@ uses
     function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function conditions_equal(const c1, c2: TAsmCond): boolean;
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
 implementation
 
@@ -570,4 +571,8 @@ implementation
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 end.

+ 5 - 0
compiler/powerpc64/cpubase.pas

@@ -397,6 +397,7 @@ function inverse_cond(const c: TAsmCond): Tasmcond;
 {$IFDEF USEINLINE}inline;{$ENDIF USEINLINE}
 function conditions_equal(const c1, c2: TAsmCond): boolean;
 function dwarf_reg(r:tregister):shortint;
+function dwarf_reg_no_error(r:tregister):shortint;
 
 implementation
 
@@ -563,6 +564,10 @@ begin
     internalerror(200603251);
 end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 
 end.
 

+ 5 - 0
compiler/sparcgen/cpubase.pas

@@ -344,6 +344,7 @@ uses
     function std_regnum_search(const s:string):Tregister;
     function findreg_by_number(r:Tregister):tregisterindex;
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
 
 implementation
@@ -530,6 +531,10 @@ implementation
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
 
     procedure TResFlags.Init(r : TRegister; f : TSparcFlags);
       begin

+ 4 - 2
compiler/x86/aoptx86.pas

@@ -2398,9 +2398,10 @@ unit aoptx86;
           (taicpu(hp2).oper[1]^.typ = top_ref) then
           begin
             CopyUsedRegs(TmpUsedRegs);
+            UpdateUsedRegs(TmpUsedRegs,tai(p.next));
             UpdateUsedRegs(TmpUsedRegs,tai(hp1.next));
-            if (RefsEqual(taicpu(hp2).oper[1]^.ref^, taicpu(p).oper[0]^.ref^) and
-              not(RegUsedAfterInstruction(taicpu(hp2).oper[0]^.reg,hp2, TmpUsedRegs))) then
+            if (RefsEqual(taicpu(hp2).oper[1]^.ref^,taicpu(p).oper[0]^.ref^) and
+              not(RegUsedAfterInstruction(taicpu(hp2).oper[0]^.reg,hp2,TmpUsedRegs))) then
               { change   mov            (ref), reg
                          add/sub/or/... reg2/$const, reg
                          mov            reg, (ref)
@@ -2444,6 +2445,7 @@ unit aoptx86;
             (taicpu(hp1).oper[1]^.typ = top_reg)
           ) and (
             GetNextInstruction(hp1, hp2) and
+            (tai(hp2).typ=ait_instruction) and
             (taicpu(hp2).opsize = S_Q) and
             (
               (

+ 6 - 0
compiler/x86/cpubase.pas

@@ -335,6 +335,7 @@ topsize2memsize: array[topsize] of integer =
     function std_regnum_search(const s:string):Tregister;
     function std_regname(r:Tregister):string;
     function dwarf_reg(r:tregister):shortint;
+    function dwarf_reg_no_error(r:tregister):shortint;
 
     function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
     function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
@@ -641,6 +642,11 @@ implementation
           internalerror(200603251);
       end;
 
+    function dwarf_reg_no_error(r:tregister):shortint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
+
 
     function segment_regs_equal(r1, r2: tregister): boolean;
       begin

+ 31 - 0
tests/webtbs/tw34380.pp

@@ -0,0 +1,31 @@
+{ Code extracted from fpc-image fpcolhash unit }
+
+{$mode objfpc}
+
+uses
+  sysutils;
+
+type
+  PColHashMainNode = ^TColHashMainNode;
+  TColHashMainNode = packed record
+    childs : array[0..16] of pointer; { can be either another MainNode or a SubNode }
+  end;
+
+  TFPColorHashTable = class (TObject)
+    function AllocateMainNode : PColHashMainNode;
+  end;
+
+function TFPColorHashTable.AllocateMainNode : PColHashMainNode;
+var tmp : PColHashMainNode;
+    i : byte;
+begin
+  Result:=nil;
+  tmp:=getmem(sizeof(TColHashMainNode));
+  if tmp=nil then raise Exception.Create('Out of memory');
+  for i:=0 to high(tmp^.childs) do
+    tmp^.childs[i]:=nil;
+  Result:=tmp;
+end;
+
+begin
+end.