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

* fix the stabs problems

Browse Source
This commit is contained in:
pierre 2000-08-21 11:27:44 +00:00
parent 9ce5d9a384
commit f1bd579bf4
6 changed files with 123 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
compiler/pmodules.pas
View File

@ -845,27 +845,22 @@ unit pmodules;
end; end;
hp:=pused_unit(hp^.next); hp:=pused_unit(hp^.next);
end; end;
if current_module^.in_implementation then if current_module^.in_implementation and
assigned(current_module^.localsymtable) then
begin begin
if assigned(current_module^.localsymtable) then { all types }
begin punitsymtable(current_module^.localsymtable)^.concattypestabto(debuglist);
{ all types } { and all local symbols}
punitsymtable(current_module^.localsymtable)^.concattypestabto(debuglist); punitsymtable(current_module^.localsymtable)^.concatstabto(debuglist);
{ and all local symbols}
punitsymtable(current_module^.localsymtable)^.concatstabto(debuglist);
end;
end end
else else if assigned(current_module^.globalsymtable) then
begin begin
if assigned(current_module^.globalsymtable) then { all types }
begin punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
{ all types } { and all local symbols}
punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist); punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
{ and all local symbols}
punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
end;
end; end;
end; end;
{$Else GDB} {$Else GDB}
begin begin
end; end;
@ -1707,10 +1702,12 @@ unit pmodules;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-07-13 12:08:26 michael Revision 1.4 2000-08-21 11:27:44 pierre
* fix the stabs problems
Revision 1.3 2000/07/13 12:08:26 michael
+ patched to 1.1.0 with former 1.09patch from peter + patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:45 michael Revision 1.2 2000/07/13 11:32:45 michael
+ removed logs + removed logs
}
}

11
compiler/symconst.pas
View File

@ -252,6 +252,12 @@ type
constresourcestring constresourcestring
); );
{$ifdef GDB}
tdefstabstatus = (
not_written,
being_written,
written);
{$endif GDB}
const const
{ relevant options for assigning a proc or a procvar to a procvar } { relevant options for assigning a proc or a procvar to a procvar }
@ -277,7 +283,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-08-06 19:39:28 peter Revision 1.6 2000-08-21 11:27:44 pierre
* fix the stabs problems
Revision 1.5 2000/08/06 19:39:28 peter
* default parameters working ! * default parameters working !
Revision 1.4 2000/08/05 13:25:06 peter Revision 1.4 2000/08/05 13:25:06 peter

100
compiler/symdef.inc
View File

@ -49,7 +49,7 @@
has_rtti:=false; has_rtti:=false;
has_inittable:=false; has_inittable:=false;
{$ifdef GDB} {$ifdef GDB}
is_def_stab_written := false; is_def_stab_written := not_written;
globalnb := 0; globalnb := 0;
{$endif GDB} {$endif GDB}
if assigned(lastglobaldef) then if assigned(lastglobaldef) then
@ -79,7 +79,7 @@
has_rtti:=false; has_rtti:=false;
has_inittable:=false; has_inittable:=false;
{$ifdef GDB} {$ifdef GDB}
is_def_stab_written := false; is_def_stab_written := not_written;
globalnb := 0; globalnb := 0;
{$endif GDB} {$endif GDB}
if assigned(lastglobaldef) then if assigned(lastglobaldef) then
@ -253,7 +253,7 @@
{set even if debuglist is not defined} {set even if debuglist is not defined}
if assigned(typesym) then if assigned(typesym) then
typesym^.isusedinstab := true; typesym^.isusedinstab := true;
if assigned(debuglist) and not is_def_stab_written then if assigned(debuglist) and (is_def_stab_written = not_written) then
concatstabto(debuglist); concatstabto(debuglist);
end; end;
if not (cs_gdb_dbx in aktglobalswitches) then if not (cs_gdb_dbx in aktglobalswitches) then
@ -321,7 +321,7 @@
var stab_str : pchar; var stab_str : pchar;
begin begin
if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
and not is_def_stab_written then and (is_def_stab_written = not_written) then
begin begin
If cs_gdb_dbx in aktglobalswitches then If cs_gdb_dbx in aktglobalswitches then
begin begin
@ -335,15 +335,16 @@
punitsymtable(typesym^.owner)^.dbx_count_ok) then punitsymtable(typesym^.owner)^.dbx_count_ok) then
begin begin
{with DBX we get the definition from the other objects } {with DBX we get the definition from the other objects }
is_def_stab_written := true; is_def_stab_written := written;
exit; exit;
end; end;
end; end;
end; end;
{ to avoid infinite loops } { to avoid infinite loops }
is_def_stab_written := true; is_def_stab_written := being_written;
stab_str := allstabstring; stab_str := allstabstring;
asmlist^.concat(new(pai_stabs,init(stab_str))); asmlist^.concat(new(pai_stabs,init(stab_str)));
is_def_stab_written := written;
end; end;
end; end;
{$endif GDB} {$endif GDB}
@ -1390,7 +1391,7 @@
begin begin
{ most file defs are unnamed !!! } { most file defs are unnamed !!! }
if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and if ((typesym = nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
not is_def_stab_written then (is_def_stab_written = not_written) then
begin begin
if assigned(typedfiletype.def) then forcestabto(asmlist,typedfiletype.def); if assigned(typedfiletype.def) then forcestabto(asmlist,typedfiletype.def);
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
@ -1510,43 +1511,47 @@
exit; exit;
if ( (typesym=nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and if ( (typesym=nil) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
not is_def_stab_written then (is_def_stab_written = not_written) then
begin begin
if assigned(pointertype.def) then is_def_stab_written := being_written;
if pointertype.def^.deftype in [recorddef,objectdef] then if assigned(pointertype.def) and
begin (pointertype.def^.deftype in [recorddef,objectdef]) then
is_def_stab_written := true; begin
nb:=pointertype.def^.numberstring; nb:=pointertype.def^.numberstring;
{to avoid infinite recursion in record with next-like fields } {to avoid infinite recursion in record with next-like fields }
is_def_stab_written := false; if pointertype.def^.is_def_stab_written = being_written then
if not pointertype.def^.is_def_stab_written then
begin begin
if assigned(pointertype.def^.typesym) then if assigned(pointertype.def^.typesym) then
begin
if assigned(typesym) then
begin begin
st := typesym^.name; if assigned(typesym) then
sym_line_no:=typesym^.fileinfo.line; begin
end st := typesym^.name;
else sym_line_no:=typesym^.fileinfo.line;
begin end
st := ' '; else
sym_line_no:=0; begin
end; st := ' ';
st := '"'+st+':t'+numberstring+'=*'+nb sym_line_no:=0;
+'=xs'+pointertype.def^.typesym^.name+':",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0'; end;
asmlist^.concat(new(pai_stabs,init(strpnew(st)))); st := '"'+st+':t'+numberstring+'=*'+nb
end; +'=xs'+pointertype.def^.typesym^.name+':",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0';
end else inherited concatstabto(asmlist); asmlist^.concat(new(pai_stabs,init(strpnew(st))));
is_def_stab_written := true; end;
end else end
begin else
{ p =^p1; p1=^p problem } begin
is_def_stab_written := true; is_def_stab_written := not_written;
forcestabto(asmlist,pointertype.def); inherited concatstabto(asmlist);
is_def_stab_written := false; end;
is_def_stab_written := written;
end
else
begin
if assigned(pointertype.def) then
forcestabto(asmlist,pointertype.def);
is_def_stab_written := not_written;
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
end; end;
end; end;
end; end;
{$endif GDB} {$endif GDB}
@ -1707,7 +1712,7 @@
procedure tsetdef.concatstabto(asmlist : paasmoutput); procedure tsetdef.concatstabto(asmlist : paasmoutput);
begin begin
if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
not is_def_stab_written then (is_def_stab_written = not_written) then
begin begin
if assigned(elementtype.def) then if assigned(elementtype.def) then
forcestabto(asmlist,elementtype.def); forcestabto(asmlist,elementtype.def);
@ -1913,7 +1918,7 @@
procedure tarraydef.concatstabto(asmlist : paasmoutput); procedure tarraydef.concatstabto(asmlist : paasmoutput);
begin begin
if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
and not is_def_stab_written then and (is_def_stab_written = not_written) then
begin begin
{when array are inserted they have no definition yet !!} {when array are inserted they have no definition yet !!}
if assigned(elementtype.def) then if assigned(elementtype.def) then
@ -2220,7 +2225,7 @@
procedure trecorddef.concatstabto(asmlist : paasmoutput); procedure trecorddef.concatstabto(asmlist : paasmoutput);
begin begin
if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
(not is_def_stab_written) then (is_def_stab_written = not_written) then
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
end; end;
@ -2586,7 +2591,7 @@
procedure tabstractprocdef.concatstabto(asmlist : paasmoutput); procedure tabstractprocdef.concatstabto(asmlist : paasmoutput);
begin begin
if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) if (not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
and not is_def_stab_written then and (is_def_stab_written = not_written) then
begin begin
if assigned(rettype.def) then forcestabto(asmlist,rettype.def); if assigned(rettype.def) then forcestabto(asmlist,rettype.def);
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
@ -3274,9 +3279,9 @@ Const local_symtable_index : longint = $8001;
procedure tprocvardef.concatstabto(asmlist : paasmoutput); procedure tprocvardef.concatstabto(asmlist : paasmoutput);
begin begin
if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) if ( not assigned(typesym) or typesym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches))
and not is_def_stab_written then and (is_def_stab_written = not_written) then
inherited concatstabto(asmlist); inherited concatstabto(asmlist);
is_def_stab_written:=true; is_def_stab_written:=written;
end; end;
{$endif GDB} {$endif GDB}
@ -3745,7 +3750,7 @@ Const local_symtable_index : longint = $8001;
end; end;
para := pparaitem(para^.next); para := pparaitem(para^.next);
end; end;
ipd^.is_def_stab_written := true; ipd^.is_def_stab_written := written;
{ here 2A must be changed for private and protected } { here 2A must be changed for private and protected }
{ 0 is private 1 protected and 2 public } { 0 is private 1 protected and 2 public }
if (sp_private in psym(p)^.symoptions) then sp:='0' if (sp_private in psym(p)^.symoptions) then sp:='0'
@ -4252,7 +4257,10 @@ Const local_symtable_index : longint = $8001;
{ {
$Log$ $Log$
Revision 1.11 2000-08-16 18:33:54 peter Revision 1.12 2000-08-21 11:27:44 pierre
* fix the stabs problems
Revision 1.11 2000/08/16 18:33:54 peter
* splitted namedobjectitem.next into indexnext and listnext so it * splitted namedobjectitem.next into indexnext and listnext so it
can be used in both lists can be used in both lists
* don't allow "word = word" type definitions (merged) * don't allow "word = word" type definitions (merged)

9
compiler/symdefh.inc
View File

@ -40,7 +40,7 @@
previousglobal : pdef; previousglobal : pdef;
{$ifdef GDB} {$ifdef GDB}
globalnb : word; globalnb : word;
is_def_stab_written : boolean; is_def_stab_written : tdefstabstatus;
{$endif GDB} {$endif GDB}
constructor init; constructor init;
constructor load; constructor load;
@ -548,7 +548,10 @@
{ {
$Log$ $Log$
Revision 1.7 2000-08-06 19:39:28 peter Revision 1.8 2000-08-21 11:27:44 pierre
* fix the stabs problems
Revision 1.7 2000/08/06 19:39:28 peter
* default parameters working ! * default parameters working !
Revision 1.6 2000/08/06 14:17:15 peter Revision 1.6 2000/08/06 14:17:15 peter
@ -573,4 +576,4 @@
Revision 1.2 2000/07/13 11:32:49 michael Revision 1.2 2000/07/13 11:32:49 michael
+ removed logs + removed logs
} }

34
compiler/symsym.inc
View File

@ -395,7 +395,7 @@
end; end;
end; end;
procedure tprocsym.check_forward; procedure tprocsym.check_forward;
var var
pd : pprocdef; pd : pprocdef;
@ -613,9 +613,12 @@
isstabwritten := true; isstabwritten := true;
if assigned(definition^.parast) then if assigned(definition^.parast) then
definition^.parast^.concatstabto(asmlist); definition^.parast^.concatstabto(asmlist);
if assigned(definition^.localst) then { local type defs and vars should not be written
inside the main proc stab }
if assigned(definition^.localst) and
(lexlevel>main_program_level) then
definition^.localst^.concatstabto(asmlist); definition^.localst^.concatstabto(asmlist);
definition^.is_def_stab_written := true; definition^.is_def_stab_written := written;
end; end;
{$endif GDB} {$endif GDB}
@ -1692,7 +1695,15 @@
begin begin
l1:=readlong; l1:=readlong;
l2:=readlong; l2:=readlong;
value:=int64(l1)+(int64(l2) shl 32); {$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
value:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end end
else else
value:=readlong; value:=readlong;
@ -1707,7 +1718,15 @@
begin begin
l1:=readlong; l1:=readlong;
l2:=readlong; l2:=readlong;
value:=int64(l1)+(int64(l2) shl 32); {$ifopt R+}
{$define Range_check_on}
{$endif opt R+}
{$R- needed here }
value:=qword(l1)+(int64(l2) shl 32);
{$ifdef Range_check_on}
{$R+}
{$undef Range_check_on}
{$endif Range_check_on}
end end
else else
value:=readlong; value:=readlong;
@ -2189,7 +2208,10 @@
{ {
$Log$ $Log$
Revision 1.5 2000-08-16 13:06:07 florian Revision 1.6 2000-08-21 11:27:44 pierre
* fix the stabs problems
Revision 1.5 2000/08/16 13:06:07 florian
+ support of 64 bit integer constants + support of 64 bit integer constants
Revision 1.4 2000/08/13 12:54:56 peter Revision 1.4 2000/08/13 12:54:56 peter

13
compiler/symtable.pas
View File

@ -1225,7 +1225,7 @@ implementation
procedure forcestabto(asmlist : paasmoutput; pd : pdef); procedure forcestabto(asmlist : paasmoutput; pd : pdef);
begin begin
if not pd^.is_def_stab_written then if pd^.is_def_stab_written = not_written then
begin begin
if assigned(pd^.typesym) then if assigned(pd^.typesym) then
pd^.typesym^.isusedinstab := true; pd^.typesym^.isusedinstab := true;
@ -2034,7 +2034,7 @@ implementation
(symtabletype in [globalsymtable,staticsymtable]) then (symtabletype in [globalsymtable,staticsymtable]) then
begin begin
ptypesym(sym)^.isusedinstab := true; ptypesym(sym)^.isusedinstab := true;
sym^.concatstabto(debuglist); {sym^.concatstabto(debuglist);}
end; end;
{$endif GDB} {$endif GDB}
end; end;
@ -2679,7 +2679,7 @@ implementation
{$ifdef GDB} {$ifdef GDB}
if assigned(def^.typesym) then if assigned(def^.typesym) then
def^.typesym^.isusedinstab:=false; def^.typesym^.isusedinstab:=false;
def^.is_def_stab_written:=false; def^.is_def_stab_written:=not_written;
{$endif GDB} {$endif GDB}
{if not current_module^.in_implementation then} {if not current_module^.in_implementation then}
begin begin
@ -2993,7 +2993,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 2000-08-20 14:58:41 peter Revision 1.6 2000-08-21 11:27:45 pierre
* fix the stabs problems
Revision 1.5 2000/08/20 14:58:41 peter
* give fatal if objfpc/delphi mode things are found (merged) * give fatal if objfpc/delphi mode things are found (merged)
Revision 1.4 2000/08/16 18:33:54 peter Revision 1.4 2000/08/16 18:33:54 peter
@ -3008,4 +3011,4 @@ end.
Revision 1.2 2000/07/13 11:32:50 michael Revision 1.2 2000/07/13 11:32:50 michael
+ removed logs + removed logs
} }