From 92acd38f4007617f9a3c101ed29a771e5d70aa6c Mon Sep 17 00:00:00 2001 From: pierre Date: Thu, 18 Oct 2018 20:21:54 +0000 Subject: [PATCH] Fix for bug report #34380 git-svn-id: trunk@39986 - --- .gitattributes | 1 + compiler/aarch64/cpubase.pas | 5 +++++ compiler/arm/cpubase.pas | 6 ++++++ compiler/avr/cpubase.pas | 5 +++++ compiler/dbgdwarf.pas | 14 +++++++++----- compiler/m68k/cpubase.pas | 5 +++++ compiler/mips/cpubase.pas | 11 +++++++++++ compiler/powerpc/cpubase.pas | 5 +++++ compiler/powerpc64/cpubase.pas | 5 +++++ compiler/riscv32/cpubase.pas | 6 ++++++ compiler/riscv64/cpubase.pas | 6 ++++++ compiler/sparcgen/cpubase.pas | 5 +++++ compiler/x86/cpubase.pas | 6 ++++++ tests/webtbs/tw34380.pp | 31 +++++++++++++++++++++++++++++++ 14 files changed, 106 insertions(+), 5 deletions(-) create mode 100644 tests/webtbs/tw34380.pp diff --git a/.gitattributes b/.gitattributes index 2963481952..e34709406b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -16398,6 +16398,7 @@ tests/webtbs/tw3429.pp svneol=native#text/plain tests/webtbs/tw3433.pp svneol=native#text/plain tests/webtbs/tw34332.pp svneol=native#text/pascal 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 diff --git a/compiler/aarch64/cpubase.pas b/compiler/aarch64/cpubase.pas index 05f8c89c68..da40529a95 100644 --- a/compiler/aarch64/cpubase.pas +++ b/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 diff --git a/compiler/arm/cpubase.pas b/compiler/arm/cpubase.pas index 68048435e2..105f2ddb0a 100644 --- a/compiler/arm/cpubase.pas +++ b/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 diff --git a/compiler/avr/cpubase.pas b/compiler/avr/cpubase.pas index 955e18484a..1e8d776bea 100644 --- a/compiler/avr/cpubase.pas +++ b/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 diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index b26be9dd6b..869dc5fcad 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -2543,7 +2543,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=''; @@ -2574,15 +2574,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)); @@ -2608,7 +2612,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)); diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas index b74ee580b7..1e33be9975 100644 --- a/compiler/m68k/cpubase.pas +++ b/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; diff --git a/compiler/mips/cpubase.pas b/compiler/mips/cpubase.pas index 70f368463c..a9be2f8b91 100644 --- a/compiler/mips/cpubase.pas +++ b/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. diff --git a/compiler/powerpc/cpubase.pas b/compiler/powerpc/cpubase.pas index e569e13423..1861c9e8f4 100644 --- a/compiler/powerpc/cpubase.pas +++ b/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. diff --git a/compiler/powerpc64/cpubase.pas b/compiler/powerpc64/cpubase.pas index 1a4d672399..e1353aedcb 100644 --- a/compiler/powerpc64/cpubase.pas +++ b/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. diff --git a/compiler/riscv32/cpubase.pas b/compiler/riscv32/cpubase.pas index f744a5f58b..ce791de4ce 100644 --- a/compiler/riscv32/cpubase.pas +++ b/compiler/riscv32/cpubase.pas @@ -329,6 +329,7 @@ uses function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE} function dwarf_reg(r:tregister):shortint; + function dwarf_reg_no_error(r:tregister):shortint; function conditions_equal(const c1,c2: TAsmCond): boolean; @@ -438,6 +439,11 @@ implementation internalerror(200603251); end; + function dwarf_reg_no_error(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + end; + function conditions_equal(const c1, c2: TAsmCond): boolean; begin result:=c1=c2; diff --git a/compiler/riscv64/cpubase.pas b/compiler/riscv64/cpubase.pas index 89ce7d292a..60cd897aa4 100644 --- a/compiler/riscv64/cpubase.pas +++ b/compiler/riscv64/cpubase.pas @@ -344,6 +344,7 @@ const function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE} function dwarf_reg(r:tregister):shortint; + function dwarf_reg_no_error(r:tregister):shortint; function conditions_equal(const c1,c2: TAsmCond): boolean; @@ -453,6 +454,11 @@ implementation internalerror(200603251); end; + function dwarf_reg_no_error(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + end; + function conditions_equal(const c1, c2: TAsmCond): boolean; begin result:=c1=c2; diff --git a/compiler/sparcgen/cpubase.pas b/compiler/sparcgen/cpubase.pas index 43b1a91d31..425f175f3f 100644 --- a/compiler/sparcgen/cpubase.pas +++ b/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 diff --git a/compiler/x86/cpubase.pas b/compiler/x86/cpubase.pas index 646116ffcf..b176657d5d 100644 --- a/compiler/x86/cpubase.pas +++ b/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 diff --git a/tests/webtbs/tw34380.pp b/tests/webtbs/tw34380.pp new file mode 100644 index 0000000000..357f4ac6ad --- /dev/null +++ b/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.