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

* fixes for local class debuggging problem (merged)

Browse Source
This commit is contained in:
pierre 2000-09-19 23:08:02 +00:00
parent ea49be5b34
commit 3c7b44cb99
3 changed files with 144 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
compiler/symdef.inc
View File

@ -232,7 +232,6 @@
inc(PglobalTypeCount^);
end;
function tdef.stabstring : pchar;
begin
stabstring := strpnew('t'+numberstring+';');
@ -2175,12 +2174,12 @@
spec:='/0'
else
spec:='';
{ class fields are pointers PM }
if not assigned(pvarsym(p)^.vartype.def) then
writeln(pvarsym(p)^.name);
if (pvarsym(p)^.vartype.def^.deftype=objectdef) and
{ class fields are pointers PM, obsolete now PM }
{if (pvarsym(p)^.vartype.def^.deftype=objectdef) and
pobjectdef(pvarsym(p)^.vartype.def)^.is_class then
spec:=spec+'*';
spec:=spec+'*'; }
size:=pvarsym(p)^.vartype.def^.size;
{ open arrays made overflows !! }
if size>$fffffff then
@ -3393,6 +3392,9 @@ Const local_symtable_index : longint = $8001;
symtable^.dataalignment:=packrecordalignment[aktpackrecords];
set_parent(c);
objname:=stringdup(n);
{$ifdef GDB}
writing_stabs:=false;
{$endif GDB}
end;
@ -3424,6 +3426,9 @@ Const local_symtable_index : longint = $8001;
is_class and
(upper(objname^)='TOBJECT') then
class_tobject:=@self;
{$ifdef GDB}
writing_stabs:=false;
{$endif GDB}
end;
@ -3786,39 +3791,115 @@ Const local_symtable_index : longint = $8001;
oldrecsize : longint;
str_end : string;
begin
oldrec := stabrecstring;
oldrecsize:=stabrecsize;
stabrecsize:=memsizeinc;
GetMem(stabrecstring,stabrecsize);
strpcopy(stabRecString,'s'+tostr(symtable^.datasize));
if assigned(childof) then
{only one ancestor not virtual, public, at base offset 0 }
{ !1 , 0 2 0 , }
strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
{virtual table to implement yet}
RecOffset := 0;
symtable^.foreach({$ifndef TP}@{$endif}addname);
if (oo_has_vmt in objectoptions) then
if not assigned(childof) or not(oo_has_vmt in childof^.objectoptions) then
begin
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
+','+tostr(vmt_offset*8)+';');
end;
symtable^.foreach({$ifndef TP}@{$endif}addprocname);
if (oo_has_vmt in objectoptions) then
if not (is_class) or writing_stabs then
begin
anc := @self;
while assigned(anc^.childof) and (oo_has_vmt in anc^.childof^.objectoptions) do
anc := anc^.childof;
str_end:=';~%'+anc^.numberstring+';';
oldrec := stabrecstring;
oldrecsize:=stabrecsize;
stabrecsize:=memsizeinc;
GetMem(stabrecstring,stabrecsize);
strpcopy(stabRecString,'s'+tostr(symtable^.datasize));
if assigned(childof) then
begin
{only one ancestor not virtual, public, at base offset 0 }
{ !1 , 0 2 0 , }
strpcopy(strend(stabrecstring),'!1,020,'+childof^.classnumberstring+';');
end;
{virtual table to implement yet}
RecOffset := 0;
inc(globalnb);
symtable^.foreach({$ifndef TP}@{$endif}addname);
dec(globalnb);
if (oo_has_vmt in objectoptions) then
if not assigned(childof) or not(oo_has_vmt in childof^.objectoptions) then
begin
strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
+','+tostr(vmt_offset*8)+';');
end;
symtable^.foreach({$ifndef TP}@{$endif}addprocname);
if (oo_has_vmt in objectoptions) then
begin
anc := @self;
while assigned(anc^.childof) and (oo_has_vmt in anc^.childof^.objectoptions) do
anc := anc^.childof;
{ just in case anc = self }
inc(globalnb);
str_end:=';~%'+anc^.classnumberstring+';';
dec(globalnb);
end
else
str_end:=';';
strpcopy(strend(stabrecstring),str_end);
stabstring := strnew(StabRecString);
freemem(stabrecstring,stabrecsize);
stabrecstring := oldrec;
stabrecsize:=oldrecsize;
end
else
str_end:=';';
strpcopy(strend(stabrecstring),str_end);
stabstring := strnew(StabRecString);
freemem(stabrecstring,stabrecsize);
stabrecstring := oldrec;
stabrecsize:=oldrecsize;
begin
stabstring:=strpnew('*'+classnumberstring);
end;
end;
procedure tobjectdef.set_globalnb;
begin
globalnb :=PGlobalTypeCount^;
inc(PglobalTypeCount^);
{ classes need two type numbers }
if is_class then
begin
globalnb :=PGlobalTypeCount^;
inc(PglobalTypeCount^);
end;
end;
function tobjectdef.classnumberstring : string;
begin
if globalnb=0 then
begin
numberstring;
end;
if is_class then
begin
dec(globalnb);
classnumberstring:=numberstring;
inc(globalnb);
end
else
classnumberstring:=numberstring;
end;
procedure tobjectdef.concatstabto(asmlist : paasmoutput);
var st : pstring;
begin
if not(is_class) then
begin
inherited concatstabto(asmlist);
exit;
end;
if ((typesym=nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
(is_def_stab_written = not_written) then
begin
if globalnb=0 then
set_globalnb;
writing_stabs:=true;
dec(globalnb);
inherited concatstabto(asmlist);
inc(globalnb);
writing_stabs:=false;
is_def_stab_written:=not_written;
if assigned(typesym) then
begin
st:=typesym^._name;
typesym^._name:=stringdup(' ');
end;
inherited concatstabto(asmlist);
if assigned(typesym) then
begin
stringdispose(typesym^._name);
typesym^._name:=st;
end;
end;
end;
{$endif GDB}
@ -4260,7 +4341,10 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.16 2000-09-10 20:13:37 peter
Revision 1.17 2000-09-19 23:08:02 pierre
* fixes for local class debuggging problem (merged)
Revision 1.16 2000/09/10 20:13:37 peter
* fixed array of const writing instead of array of tvarrec (merged)
Revision 1.15 2000/09/09 18:36:40 peter
@ -4318,4 +4402,4 @@ Const local_symtable_index : longint = $8001;
Revision 1.2 2000/07/13 11:32:49 michael
+ removed logs
}
}

13
compiler/symdefh.inc
View File

@ -60,7 +60,7 @@
function stabstring : pchar;virtual;
procedure concatstabto(asmlist : paasmoutput);virtual;
function NumberString:string;
procedure set_globalnb;
procedure set_globalnb;virtual;
function allstabstring : pchar;
{$endif GDB}
{ init. tables }
@ -193,6 +193,9 @@
{ to be able to have a variable vmt position }
{ and no vmt field for objects without virtuals }
vmt_offset : longint;
{$ifdef GDB}
writing_stabs : boolean;
{$endif GDB}
constructor init(const n : string;c : pobjectdef);
constructor load;
destructor done;virtual;
@ -217,6 +220,9 @@
{ debug }
{$ifdef GDB}
function stabstring : pchar;virtual;
procedure set_globalnb;virtual;
function classnumberstring : string;
procedure concatstabto(asmlist : paasmoutput);virtual;
{$endif GDB}
{ init/final }
function needs_inittable : boolean;virtual;
@ -548,7 +554,10 @@
{
$Log$
Revision 1.8 2000-08-21 11:27:44 pierre
Revision 1.9 2000-09-19 23:08:03 pierre
* fixes for local class debuggging problem (merged)
Revision 1.8 2000/08/21 11:27:44 pierre
* fix the stabs problems
Revision 1.7 2000/08/06 19:39:28 peter

33
compiler/symsym.inc
View File

@ -1424,20 +1424,16 @@
{$ifdef GDB}
function tvarsym.stabstring : pchar;
var
st : string[2];
st : string;
begin
if (vartype.def^.deftype=objectdef) and
pobjectdef(vartype.def)^.is_class then
st:='*'
else
st:='';
st:=vartype.def^.numberstring;
if (owner^.symtabletype = objectsymtable) and
(sp_static in symoptions) then
begin
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
{$ifndef Delphi}
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+st+
+vartype.def^.numberstring+'",'+
'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
{$endif}
end
@ -1449,14 +1445,12 @@
but searches the same name or with a leading underscore
but these names don't exist in pascal !}
if (cs_gdb_gsym in aktglobalswitches) then st := 'G'+st else st := 'S'+st;
stabstring := strpnew('"'+name+':'+st
+vartype.def^.numberstring+'",'+
stabstring := strpnew('"'+name+':'+st+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if owner^.symtabletype = staticsymtable then
begin
stabstring := strpnew('"'+name+':S'+st
+vartype.def^.numberstring+'",'+
stabstring := strpnew('"'+name+':S'+st+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
end
else if (owner^.symtabletype in [parasymtable,inlineparasymtable]) then
@ -1470,8 +1464,7 @@
else
st := 'p'+st;
end;
stabstring := strpnew('"'+name+':'+st
+vartype.def^.numberstring+'",'+
stabstring := strpnew('"'+name+':'+st+'",'+
tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
tostr(address+owner^.address_fixup));
{offset to ebp => will not work if the framepointer is esp
@ -1483,8 +1476,7 @@
begin
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
stabstring:=strpnew('"'+name+':r'+st
+vartype.def^.numberstring+'",'+
stabstring:=strpnew('"'+name+':r'+st+'",'+
tostr(N_RSYM)+',0,'+
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
end
@ -1492,12 +1484,10 @@
{$endif i386}
{ I don't know if this will work (PM) }
if (vo_is_C_var in varoptions) then
stabstring := strpnew('"'+name+':S'+st
+vartype.def^.numberstring+'",'+
stabstring := strpnew('"'+name+':S'+st+'",'+
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
else
stabstring := strpnew('"'+name+':'+st
+vartype.def^.numberstring+'",'+
stabstring := strpnew('"'+name+':'+st+'",'+
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address-owner^.address_fixup))
else
stabstring := inherited stabstring;
@ -2226,7 +2216,10 @@
{
$Log$
Revision 1.7 2000-08-27 20:19:39 peter
Revision 1.8 2000-09-19 23:08:03 pierre
* fixes for local class debuggging problem (merged)
Revision 1.7 2000/08/27 20:19:39 peter
* store strings with case in ppu, when an internal symbol is created
a '$' is prefixed so it's not automatic uppercased