paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 22:50:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for properties in DWARF2 where the accessor does not use a function

Browse Source 
git-svn-id: trunk@12883 -
This commit is contained in:
Jonas Maebe 2009-03-14 11:12:46 +00:00
parent b86cb8ba55
commit 2b69768afc
3 changed files with 76 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8797,6 +8797,7 @@ tests/webtbs/tw1323.pp svneol=native#text/plain
tests/webtbs/tw1327.pp svneol=native#text/plain
tests/webtbs/tw1331.pp svneol=native#text/plain
tests/webtbs/tw13313.pp svneol=native#text/plain
tests/webtbs/tw13313a.pp svneol=native#text/plain
tests/webtbs/tw1333.pp svneol=native#text/plain
tests/webtbs/tw1348.pp svneol=native#text/plain
tests/webtbs/tw1351.pp svneol=native#text/plain

65
compiler/dbgdwarf.pas
View File

@ -262,9 +262,14 @@ interface
procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override;
procedure appendprocdef(list:TAsmList;def:tprocdef);override;
function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
{ used for global/static variables, local variables, parameters and
absolute variables
}
procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint);
procedure append_nonobject_symlist_for_name_type(list:TAsmList; symlist: ppropaccesslistitem; const name: string; def: tdef);
{ used for fields and properties mapped to fields }
procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
procedure beforeappendsym(list:TAsmList;sym:tsym);override;
procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override;
@ -1738,28 +1743,27 @@ implementation
end;
procedure TDebugInfoDwarf.append_nonobject_symlist_for_name_type(list:TAsmList; symlist: ppropaccesslistitem; const name: string; def: tdef);
function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
var
sym : tabstractnormalvarsym;
offset,
elesize : pint;
currdef : tdef;
begin
result:=false;
if not assigned(symlist) then
exit;
sym:=nil;
offset:=0;
currdef:=nil;
sym:=nil;
repeat
case symlist^.sltype of
sl_load:
begin
if assigned(sym) then
internalerror(2009031203);
if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym]) then
if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then
{ can't handle... }
exit;
sym:=tabstractnormalvarsym(symlist^.sym);
sym:=tabstractvarsym(symlist^.sym);
currdef:=tabstractvarsym(sym).vardef;
end;
sl_subscript:
@ -1803,12 +1807,14 @@ implementation
inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize);
currdef:=tarraydef(currdef).elementdef;
end;
else
internalerror(2009031401);
end;
symlist:=symlist^.next;
until not assigned(symlist);
if not assigned(sym) then
internalerror(2009031205);
appendsym_var_with_name_type_offset(list,sym,name,def,offset);
result:=true;
end;
@ -1972,6 +1978,12 @@ implementation
procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym);
begin
appendsym_fieldvar_with_name_offset(list,sym,symname(sym),sym.vardef,0);
end;
procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
var
bitoffset,
fieldoffset,
@ -1992,8 +2004,9 @@ implementation
fieldoffset:=sym.fieldoffset
else
fieldoffset:=sym.fieldoffset div 8;
inc(fieldoffset,offset);
append_entry(DW_TAG_member,false,[
DW_AT_name,DW_FORM_string,symname(sym)+#0,
DW_AT_name,DW_FORM_string,name+#0,
DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset)
]);
end
@ -2008,6 +2021,7 @@ implementation
{ does. }
fieldnatsize:=max(sizeof(pint),sym.vardef.size);
fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize;
inc(fieldoffset,offset);
bitoffset:=sym.fieldoffset mod (fieldnatsize*8);
if (target_info.endian=endian_little) then
bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize;
@ -2026,7 +2040,7 @@ implementation
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst)));
current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset));
append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef));
append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
finish_entry;
end;
@ -2123,8 +2137,29 @@ implementation
procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym);
var
symlist: ppropaccesslistitem;
tosym: tabstractvarsym;
offset: pint;
begin
{ ignored for now }
if assigned(sym.propaccesslist[palt_read]) and
not assigned(sym.propaccesslist[palt_read].procdef) then
symlist:=sym.propaccesslist[palt_read].firstsym
else
{ can't handle }
exit;
if not get_symlist_sym_offset(symlist,tosym,offset) then
exit;
if (tosym.owner.symtabletype<>objectsymtable) then
begin
if (tosym.typ=fieldvarsym) then
internalerror(2009031404);
appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),sym.propdef,offset)
end
else
appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym),sym.propdef,offset)
end;
@ -2152,6 +2187,8 @@ implementation
templist : TAsmList;
blocksize : longint;
symlist : ppropaccesslistitem;
tosym: tabstractvarsym;
offset: pint;
begin
templist:=TAsmList.create;
case tabsolutevarsym(sym).abstyp of
@ -2178,8 +2215,10 @@ implementation
tovar:
begin
symlist:=tabsolutevarsym(sym).ref.firstsym;
append_nonobject_symlist_for_name_type(list,symlist,symname(sym),tabstractvarsym(sym).vardef);
get_symlist_sym_offset(symlist,tosym,offset);
if (tosym.typ=fieldvarsym) then
internalerror(2009031402);
appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),tabstractvarsym(sym).vardef,offset);
templist.free;
exit;
end;

23
tests/webtbs/tw13313a.pp Normal file
View File

@ -0,0 +1,23 @@
{ %interactive }
{ run in gdb, "print a.a7" when reaching the writeln and
check that the output is 8
}
{$mode objfpc}
type
ta = class
private
fa: array[6..10] of byte;
public
property a7: byte read fa[7];
end;
var
a: ta;
begin
a:=ta.create;
a.fa[7]:=8;
writeln(a.a7);
end.