paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 12:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* move all stabs ($ifdef gdb) code to dbgstabs

Browse Source 
git-svn-id: trunk@1255 -
This commit is contained in:
peter 2005-10-02 11:17:05 +00:00
parent edf553a223
commit 89297d2c39
33 changed files with 1577 additions and 2288 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/aasmbase.pas
View File

@ -101,7 +101,7 @@ interface
{ is the label only there for getting an address (e.g. for i/o
checks -> alt_addr) or is it a jump target (alt_jump), for debug
info alt_dbgline and alt_dbgfile }
TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile);
TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype);
TAsmLabel = class(TAsmSymbol)
labelnr : longint;
@ -249,7 +249,7 @@ interface
const
{ alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile }
asmlabeltypeprefix : array[tasmlabeltype] of char = ('j','a','d','l','f');
asmlabeltypeprefix : array[tasmlabeltype] of char = ('j','a','d','l','f','t');
var
objectlibrary : tasmlibrarydata;

121
compiler/cutils.pas
View File

@ -32,7 +32,6 @@ interface
type
pstring = ^string;
get_var_value_proc=function(const s:string):string of object;
Tcharset=set of char;
var
@ -108,8 +107,6 @@ interface
function strpnew(const s : string) : pchar;
procedure strdispose(var p : pchar);
function string_evaluate(s:string;get_var_value:get_var_value_proc;
const vars:array of string):Pchar;
{# makes the character @var(c) lowercase, with spanish, french and german
character set
}
@ -844,124 +841,6 @@ uses
CompareText:=0;
end;
function string_evaluate(s:string;get_var_value:get_var_value_proc;
const vars:array of string):Pchar;
{S contains a prototype of a stabstring. Stabstr_evaluate will expand
variables and parameters.
Output is s in ASCIIZ format, with the following expanded:
${varname} - The variable name is expanded.
$n - The parameter n is expanded.
$$ - Is expanded to $
}
const maxvalue=9;
maxdata=1023;
var i,j:byte;
varname:string[63];
varno,varcounter:byte;
varvalues:array[0..9] of Pstring;
{1 kb of parameters is the limit. 256 extra bytes are allocated to
ensure buffer integrity.}
varvaluedata:array[0..maxdata+256] of char;
varptr:Pchar;
len:cardinal;
r:Pchar;
begin
{Two pass approach, first, calculate the length and receive variables.}
i:=1;
len:=0;
varcounter:=0;
varptr:=@varvaluedata;
while i<=length(s) do
begin
if (s[i]='$') and (i<length(s)) then
begin
if s[i+1]='$' then
begin
inc(len);
inc(i);
end
else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
begin
varname:='';
inc(i,2);
repeat
inc(varname[0]);
varname[length(varname)]:=s[i];
s[i]:=char(varcounter);
inc(i);
until s[i]='}';
varvalues[varcounter]:=Pstring(varptr);
if varptr>@varvaluedata+maxdata then
internalerrorproc(200411152);
Pstring(varptr)^:=get_var_value(varname);
inc(len,length(Pstring(varptr)^));
inc(varptr,length(Pstring(varptr)^)+1);
inc(varcounter);
end
else if s[i+1] in ['0'..'9'] then
begin
inc(len,length(vars[byte(s[i+1])-byte('1')]));
inc(i);
end;
end
else
inc(len);
inc(i);
end;
{Second pass, writeout stabstring.}
getmem(r,len+1);
string_evaluate:=r;
i:=1;
while i<=length(s) do
begin
if (s[i]='$') and (i<length(s)) then
begin
if s[i+1]='$' then
begin
r^:='$';
inc(r);
inc(i);
end
else if (s[i+1]='{') and (length(s)>2) and (i<length(s)-2) then
begin
varname:='';
inc(i,2);
varno:=byte(s[i]);
repeat
inc(i);
until s[i]='}';
for j:=1 to length(varvalues[varno]^) do
begin
r^:=varvalues[varno]^[j];
inc(r);
end;
end
else if s[i+1] in ['0'..'9'] then
begin
for j:=1 to length(vars[byte(s[i+1])-byte('1')]) do
begin
r^:=vars[byte(s[i+1])-byte('1')][j];
inc(r);
end;
inc(i);
end
end
else
begin
r^:=s[i];
inc(r);
end;
inc(i);
end;
r^:=#0;
end;
{*****************************************************************************
GetSpeedValue

44
compiler/dbgbase.pas
View File

@ -27,14 +27,23 @@ interface
uses
systems,
symdef,symtype,
symsym,
aasmtai;
type
TDebugInfo=class
constructor Create;virtual;
procedure insertvmt(list:taasmoutput;objdef:tobjectdef);virtual;
procedure insertsym(list:taasmoutput;sym:tsym);virtual;
procedure insertdef(list:taasmoutput;def:tdef);virtual;
procedure insertmoduletypes(list:taasmoutput);virtual;
procedure insertprocstart(list:taasmoutput);virtual;
procedure insertprocend(list:taasmoutput);virtual;
procedure insertmodulestart(list:taasmoutput);virtual;
procedure insertmoduleend(list:taasmoutput);virtual;
procedure insertlineinfo(list:taasmoutput);virtual;
procedure referencesections(list:taasmoutput);virtual;
end;
TDebugInfoClass=class of TDebugInfo;
@ -58,6 +67,36 @@ implementation
end;
procedure tdebuginfo.insertvmt(list:taasmoutput;objdef:tobjectdef);
begin
end;
procedure tdebuginfo.insertsym(list:taasmoutput;sym:tsym);
begin
end;
procedure tdebuginfo.insertdef(list:taasmoutput;def:tdef);
begin
end;
procedure tdebuginfo.insertmoduletypes(list:taasmoutput);
begin
end;
procedure tdebuginfo.insertprocstart(list:taasmoutput);
begin
end;
procedure tdebuginfo.insertprocend(list:taasmoutput);
begin
end;
procedure tdebuginfo.insertmodulestart(list:taasmoutput);
begin
end;
@ -73,6 +112,11 @@ implementation
end;
procedure tdebuginfo.referencesections(list:taasmoutput);
begin
end;
procedure InitDebugInfo;
begin
if not assigned(CDebugInfo[target_dbg.id]) then

1363
compiler/dbgstabs.pas
View File

File diff suppressed because it is too large Load Diff

17
compiler/defcmp.pas
View File

@ -943,13 +943,25 @@ implementation
begin
{ procedure variable can be assigned to an void pointer,
this not allowed for methodpointers }
if is_void(tpointerdef(def_to).pointertype.def) and
if (is_void(tpointerdef(def_to).pointertype.def) or
(m_mac_procvar in aktmodeswitches)) and
tprocvardef(def_from).is_addressonly then
begin
doconv:=tc_equal;
eq:=te_convert_l1;
end;
end;
procdef :
begin
{ procedure variable can be assigned to an void pointer,
this not allowed for methodpointers }
if (m_mac_procvar in aktmodeswitches) and
tprocdef(def_from).is_addressonly then
begin
doconv:=tc_proc_2_procvar;
eq:=te_convert_l2;
end;
end;
classrefdef,
objectdef :
begin
@ -1004,7 +1016,8 @@ implementation
procdef :
begin
{ proc -> procvar }
if (m_tp_procvar in aktmodeswitches) then
if (m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches) then
begin
subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),true);
if subeq>te_incompatible then

55
compiler/gdb.pas
View File

@ -1,55 +0,0 @@
{
Copyright (c) 1998-2002 by Florian Klaempfl
This units contains special support for the GDB
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit gdb;
{$i fpcdefs.inc}
interface
uses
strings,
globtype,
aasmtai;
{stab constants }
Const
N_GSYM = $20;
N_STSYM = 38; {initialized const }
N_LCSYM = 40; {non initialized variable}
N_Function = $24; {function or const }
N_TextLine = $44;
N_DataLine = $46;
N_BssLine = $48;
N_RSYM = $40; { register variable }
N_LSYM = $80;
N_tsym = 160;
N_SourceFile = $64;
N_IncludeFile = $84;
N_BINCL = $82;
N_EINCL = $A2;
N_EXCL = $C2;
implementation
uses fmodule;
end.

2
compiler/globals.pas
View File

@ -65,7 +65,7 @@ interface
gpcmodeswitches : tmodeswitches=
[m_gpc,m_all,m_tp_procvar];
macmodeswitches : tmodeswitches=
[m_mac,m_all,m_result,m_cvar_support,m_tp_procvar];
[m_mac,m_all,m_result,m_cvar_support,m_mac_procvar];
{ maximum nesting of routines }

3
compiler/globtype.pas
View File

@ -120,7 +120,7 @@ than 255 characters. That's why using Ansi Strings}
{ browser }
cs_browser_log,
{ debuginfo }
cs_gdb_heaptrc,cs_gdb_lineinfo,
cs_use_heaptrc,cs_use_lineinfo,
cs_gdb_valgrind,
{ assembling }
cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source,
@ -144,6 +144,7 @@ than 255 characters. That's why using Ansi Strings}
m_cvar_support, { cvar variable directive }
m_nested_comment, { nested comments }
m_tp_procvar, { tp style procvars (no @ needed) }
m_mac_procvar, { macpas style procvars }
m_repeat_forward, { repeating forward declarations is needed }
m_pointer_2_procedure, { allows the assignement of pointers to
procedure variables }

12
compiler/htypechk.pas
View File

@ -715,7 +715,8 @@ implementation
begin
result:=false;
{ remove voidpointer typecast for tp procvars }
if (m_tp_procvar in aktmodeswitches) and
if ((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)) and
(p.nodetype=typeconvn) and
is_voidpointer(p.resulttype.def) then
p:=tunarynode(p).left;
@ -1363,10 +1364,15 @@ implementation
procvardef :
begin
{ in tp7 mode proc -> procvar is allowed }
if (m_tp_procvar in aktmodeswitches) and
if ((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)) and
(p.left.nodetype=calln) and
(proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),true)>=te_equal) then
eq:=te_equal;
eq:=te_equal
else
if (m_mac_procvar in aktmodeswitches) and
is_procvar_load(p.left) then
eq:=te_convert_l2;
end;
end;
end;

16
compiler/i386/csopt386.pas
View File

@ -995,19 +995,11 @@ begin
if getLastInstruction(hp,prev) then
with ptaiprop(prev.optinfo)^ do
begin
{$ifopt r+}
{$define rangeon}
{$r-}
{$endif}
newOrgRegRState := regs[orgReg].rState +
ptaiprop(hp.optinfo)^.regs[newReg].rState - regs[newReg].rstate;
newOrgRegRState := byte(longint(regs[orgReg].rState) +
longint(ptaiprop(hp.optinfo)^.regs[newReg].rState) - regs[newReg].rstate);
if writeStateToo then
newOrgRegWState := regs[orgReg].wState +
ptaiprop(hp.optinfo)^.regs[newReg].wState - regs[newReg].wstate;
{$ifdef rangeon}
{$undef rangeon}
{$r+}
{$endif}
newOrgRegWState := byte(longint(regs[orgReg].wState) +
longint(ptaiprop(hp.optinfo)^.regs[newReg].wState) - regs[newReg].wstate);
end
else
with ptaiprop(hp.optinfo)^.regs[newReg] do

24
compiler/ncal.pas
View File

@ -476,7 +476,8 @@ type
procedure tcallparanode.insert_typeconv(do_count : boolean);
var
oldtype : ttype;
oldtype : ttype;
hp : tnode;
{$ifdef extdebug}
store_count_ref : boolean;
{$endif def extdebug}
@ -506,6 +507,21 @@ type
resulttype:=left.resulttype;
end;
{ Remove implicitly inserted typecast to pointer for
@procvar in macpas }
if (m_mac_procvar in aktmodeswitches) and
(parasym.vartype.def.deftype=procvardef) and
(left.nodetype=typeconvn) and
is_voidpointer(left.resulttype.def) and
(ttypeconvnode(left).left.nodetype=typeconvn) and
(ttypeconvnode(ttypeconvnode(left).left).convtype=tc_proc_2_procvar) then
begin
hp:=left;
left:=ttypeconvnode(left).left;
ttypeconvnode(hp).left:=nil;
hp.free;
end;
{ Handle varargs and hidden paras directly, no typeconvs or }
{ typechecking needed }
if (cpf_varargs_para in callparaflags) then
@ -617,7 +633,8 @@ type
if (parasym.vartype.def.deftype=formaldef) then
begin
{ load procvar if a procedure is passed }
if (m_tp_procvar in aktmodeswitches) and
if ((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)) and
(left.nodetype=calln) and
(is_void(left.resulttype.def)) then
load_procvar_from_calln(left);
@ -1625,7 +1642,8 @@ type
loadnode will give a strange error }
if not(assigned(left)) and
not(cnf_inherited in callnodeflags) and
(m_tp_procvar in aktmodeswitches) and
((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)) and
(symtableprocentry.procdef_count=1) then
begin
hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc);

65
compiler/ncgmem.pas
View File

@ -211,7 +211,7 @@ implementation
else
internalerror(200507031);
end;
if (cs_gdb_heaptrc in aktglobalswitches) and
if (cs_use_heaptrc in aktglobalswitches) and
(cs_checkpointer in aktlocalswitches) and
not(cs_compilesystem in aktmoduleswitches) and
not(tpointerdef(left.resulttype.def).is_far) and
@ -269,7 +269,7 @@ implementation
end;
end;
{ implicit deferencing }
if (cs_gdb_heaptrc in aktglobalswitches) and
if (cs_use_heaptrc in aktglobalswitches) and
(cs_checkpointer in aktlocalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
@ -287,7 +287,7 @@ implementation
tg.GetTempTyped(exprasmlist,left.resulttype.def,tt_normal,location.reference);
cg.a_load_loc_ref(exprasmlist,OS_ADDR,left.location,location.reference);
{ implicit deferencing also for interfaces }
if (cs_gdb_heaptrc in aktglobalswitches) and
if (cs_use_heaptrc in aktglobalswitches) and
(cs_checkpointer in aktlocalswitches) and
not(cs_compilesystem in aktmoduleswitches) then
begin
@ -315,70 +315,11 @@ implementation
*****************************************************************************}
procedure tcgwithnode.pass_2;
{$ifdef WITHNODEDEBUG}
const
withlevel : longint = 0;
var
withstartlabel,withendlabel : tasmlabel;
pp : pchar;
mangled_length : longint;
refnode : tnode;
{$endif WITHNODEDEBUG}
begin
location_reset(location,LOC_VOID,OS_NO);
{$ifdef WITHNODEDEBUG}
if (cs_debuginfo in aktmoduleswitches) then
begin
{ load reference }
if (withrefnode.nodetype=derefn) and
(tderefnode(withrefnode).left.nodetype=temprefn) then
refnode:=tderefnode(withrefnode).left
else
refnode:=withrefnode;
secondpass(refnode);
location_freetemp(exprasmlist,refnode.location);
if not(refnode.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
internalerror(2003092810);
inc(withlevel);
objectlibrary.getaddrlabel(withstartlabel);
objectlibrary.getaddrlabel(withendlabel);
cg.a_label(exprasmlist,withstartlabel);
al_withdebug.concat(Tai_stab.create(stab_stabs,strpnew(
'"with'+tostr(withlevel)+':'+tostr(symtablestack.getnewtypecount)+
'=*'+tstoreddef(left.resulttype.def).numberstring+'",'+
tostr(N_LSYM)+',0,0,'+tostr(refnode.location.reference.offset))));
mangled_length:=length(current_procinfo.procdef.mangledname);
getmem(pp,mangled_length+50);
strpcopy(pp,'192,0,0,'+withstartlabel.name);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(pp),'-');
strpcopy(strend(pp),current_procinfo.procdef.mangledname);
end;
al_withdebug.concat(Tai_stabn.Create(strnew(pp)));
end;
{$endif WITHNODEDEBUG}
if assigned(left) then
secondpass(left);
{$ifdef WITHNODEDEBUG}
if (cs_debuginfo in aktmoduleswitches) then
begin
cg.a_label(exprasmlist,withendlabel);
strpcopy(pp,'224,0,0,'+withendlabel.name);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(pp),'-');
strpcopy(strend(pp),current_procinfo.procdef.mangledname);
end;
al_withdebug.concat(Tai_stabn.Create(strnew(pp)));
freemem(pp,mangled_length+50);
dec(withlevel);
end;
{$endif WITHNODEDEBUG}
end;

115
compiler/ncgutil.pas
View File

@ -118,15 +118,12 @@ interface
implementation
uses
strings,version,
version,
cutils,cclasses,
globals,systems,verbose,
ppu,defutil,
procinfo,paramgr,fmodule,
regvars,dwarf,
{$ifdef GDB}
gdb,
{$endif GDB}
regvars,dwarf,dbgbase,
pass_1,pass_2,
ncon,nld,nutils,
tgobj,cgobj;
@ -1602,10 +1599,7 @@ implementation
cg.deallocallcpuregisters(list);
end;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list.concat(Tai_force_line.Create);
{$endif GDB}
list.concat(Tai_force_line.Create);
{$ifdef OLDREGVARS}
load_regvars(list,nil);
@ -1642,13 +1636,8 @@ implementation
else
list.concat(Tai_align.create(aktalignment.procalign));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
current_procinfo.procdef.concatstabto(list);
Tprocsym(current_procinfo.procdef.procsym).isstabwritten:=true;
end;
{$endif GDB}
debuginfo.insertprocstart(list);
repeat
hs:=current_procinfo.procdef.aliasnames.getfirst;
@ -1667,13 +1656,6 @@ implementation
procedure gen_proc_symbol_end(list:Taasmoutput);
{$ifdef GDB}
var
stabsendlabel : tasmlabel;
mangled_length : longint;
p : pchar;
hp : tused_unit;
{$endif GDB}
begin
if (current_procinfo.procdef.proctypeoption=potype_proginit) then
begin
@ -1685,94 +1667,15 @@ implementation
' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
end;
{$ifdef GDB}
{ Reference all DEBUGINFO sections from the main .text section }
if (target_info.system <> system_powerpc_macos) and
(cs_debuginfo in aktmoduleswitches) then
begin
{ include reference to all debuginfo sections of used units }
hp:=tused_unit(usedunits.first);
while assigned(hp) do
begin
If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
hp:=tused_unit(hp.next);
end;
{ include reference to debuginfo for this program }
list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
end;
{$endif GDB}
if (cs_debuginfo in aktmoduleswitches) then
debuginfo.referencesections(list);
end;
list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
objectlibrary.getjumplabel(stabsendlabel);
cg.a_label(list,stabsendlabel);
{ define calling EBP as pseudo local var PM }
{ this enables test if the function is a local one !! }
{if assigned(current_procinfo.parent) and
(current_procinfo.procdef.parast.symtablelevel>normal_function_level) then
list.concat(Tai_stab.create(stab_stabs,strpnew(
'"parent_ebp:'+tstoreddef(voidpointertype.def).numberstring+'",'+
tostr(N_LSYM)+',0,0,'+tostr(current_procinfo.parent_framepointer_offset)))); }
if assigned(current_procinfo.procdef.funcretsym) and
(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).refs>0) then
begin
if tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.loc=LOC_REFERENCE then
begin
{$warning Need to add gdb support for ret in param register calling}
if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
begin
list.concat(Tai_stab.create(stab_stabs,strpnew(
'"'+current_procinfo.procdef.procsym.name+':X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
if (m_result in aktmodeswitches) then
list.concat(Tai_stab.create(stab_stabs,strpnew(
'"RESULT:X*'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))))
end
else
begin
list.concat(Tai_stab.create(stab_stabs,strpnew(
'"'+current_procinfo.procdef.procsym.name+':X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
if (m_result in aktmodeswitches) then
list.concat(Tai_stab.create(stab_stabs,strpnew(
'"RESULT:X'+tstoreddef(current_procinfo.procdef.rettype.def).numberstring+'",'+
tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset))));
end;
end;
end;
mangled_length:=length(current_procinfo.procdef.mangledname);
getmem(p,2*mangled_length+50);
strpcopy(p,'192,0,0,');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(p),'-');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
end;
list.concat(Tai_stab.Create(stab_stabn,strnew(p)));
{List.concat(Tai_stab.Create_str(stab_stabn,'192,0,0,'+current_procinfo.procdef.mangledname)));
p[0]:='2';p[1]:='2';p[2]:='4';
strpcopy(strend(p),'_end');}
strpcopy(p,'224,0,0,'+stabsendlabel.name);
if (target_info.use_function_relative_addresses) then
begin
strpcopy(strend(p),'-');
strpcopy(strend(p),current_procinfo.procdef.mangledname);
end;
list.concatlist(asmlist[al_withdebug]);
list.concat(Tai_stab.Create(stab_stabn,strnew(p)));
{ strpnew('224,0,0,'
+current_procinfo.procdef.mangledname+'_end'))));}
freemem(p,2*mangled_length+50);
end;
{$endif GDB}
debuginfo.insertprocend(list);
end;
@ -1938,10 +1841,8 @@ implementation
varalign:=var_align(l);
maybe_new_object_file(list);
new_section(list,sectype,lower(sym.mangledname),varalign);
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
sym.concatstabto(list);
{$endif GDB}
debuginfo.insertsym(list,sym);
if (sym.owner.symtabletype=globalsymtable) or
maybe_smartlink_symbol or
DLLSource or

77
compiler/ncnv.pas
View File

@ -1465,45 +1465,46 @@ implementation
own resulttype.def. They will therefore always be incompatible with
a procvar. Because isconvertable cannot check for procedures we
use an extra check for them.}
if (m_tp_procvar in aktmodeswitches) and
(resulttype.def.deftype=procvardef) then
if (left.nodetype=calln) and
(tcallnode(left).para_count=0) and
(resulttype.def.deftype=procvardef) and
(
(m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches)
) then
begin
if (left.nodetype=calln) and
(tcallnode(left).para_count=0) then
begin
if assigned(tcallnode(left).right) then
begin
{ this is already a procvar, if it is really equal
is checked below }
convtype:=tc_equal;
hp:=tcallnode(left).right.getcopy;
currprocdef:=tabstractprocdef(hp.resulttype.def);
end
else
begin
convtype:=tc_proc_2_procvar;
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
tprocdef(currprocdef),tcallnode(left).symtableproc);
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) then
begin
if assigned(tcallnode(left).methodpointer) then
tloadnode(hp).set_mp(tcallnode(left).get_load_methodpointer)
else
tloadnode(hp).set_mp(load_self_node);
end;
resulttypepass(hp);
end;
left.free;
left:=hp;
{ Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type }
if not(nf_explicit in flags) and
(proc_to_procvar_equal(currprocdef,
tprocvardef(resulttype.def),true)=te_incompatible) then
IncompatibleTypes(left.resulttype.def,resulttype.def);
exit;
end;
if assigned(tcallnode(left).right) then
begin
{ this is already a procvar, if it is really equal
is checked below }
convtype:=tc_equal;
hp:=tcallnode(left).right.getcopy;
currprocdef:=tabstractprocdef(hp.resulttype.def);
end
else
begin
convtype:=tc_proc_2_procvar;
currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).search_procdef_byprocvardef(Tprocvardef(resulttype.def));
hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry),
tprocdef(currprocdef),tcallnode(left).symtableproc);
if (tcallnode(left).symtableprocentry.owner.symtabletype=objectsymtable) then
begin
if assigned(tcallnode(left).methodpointer) then
tloadnode(hp).set_mp(tcallnode(left).get_load_methodpointer)
else
tloadnode(hp).set_mp(load_self_node);
end;
resulttypepass(hp);
end;
left.free;
left:=hp;
{ Now check if the procedure we are going to assign to
the procvar, is compatible with the procvar's type }
if not(nf_explicit in flags) and
(proc_to_procvar_equal(currprocdef,
tprocvardef(resulttype.def),true)=te_incompatible) then
IncompatibleTypes(left.resulttype.def,resulttype.def);
exit;
end;
{ Handle explicit type conversions }

10
compiler/nmem.pas
View File

@ -354,8 +354,11 @@ implementation
{ Handle @proc special, also @procvar in tp-mode needs
special handling }
if (left.resulttype.def.deftype=procdef) or
((left.resulttype.def.deftype=procvardef) and
(m_tp_procvar in aktmodeswitches)) then
(
(left.resulttype.def.deftype=procvardef) and
((m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches))
) then
begin
isprocvar:=(left.resulttype.def.deftype=procvardef);
@ -368,7 +371,8 @@ implementation
{ In tp procvar mode the result is always a voidpointer. Insert
a typeconversion to voidpointer. For methodpointers we need
to load the proc field }
if (m_tp_procvar in aktmodeswitches) then
if (m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches) then
begin
if tabstractprocdef(left.resulttype.def).is_addressonly then
begin

16
compiler/nobj.pas
View File

@ -129,10 +129,8 @@ implementation
uses
strings,
globals,verbose,systems,
symtable,symconst,symtype,defcmp
{$ifdef GDB}
,gdb
{$endif GDB}
symtable,symconst,symtype,defcmp,
dbgbase
;
@ -1280,15 +1278,9 @@ implementation
{ write debug info }
maybe_new_object_file(asmlist[al_globals]);
new_section(asmlist[al_globals],sec_rodata,_class.vmt_mangledname,const_align(sizeof(aint)));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if assigned(_class.owner) and assigned(_class.owner.name) then
asmlist[al_globals].concat(Tai_stab.create(stab_stabs,strpnew('"vmt_'+_class.owner.name^+_class.name+':S'+
tstoreddef(vmttype.def).numberstring+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname)));
end;
{$endif GDB}
asmlist[al_globals].concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0));
debuginfo.insertvmt(asmlist[al_globals],_class);
asmlist[al_globals].concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0));
{ determine the size with symtable.datasize, because }
{ size gives back 4 for classes }

2
compiler/ogcoff.pas
View File

@ -535,7 +535,7 @@ const go32v2stub : array[0..2047] of byte=(
createsection(sec_code,'',0,[]);
createsection(sec_data,'',0,[]);
createsection(sec_bss,'',0,[]);
if (cs_gdb_lineinfo in aktglobalswitches) or
if (cs_use_lineinfo in aktglobalswitches) or
(cs_debuginfo in aktmoduleswitches) then
begin
stabssec:=createsection(sec_stab,'',0,[]);

12
compiler/options.pas
View File

@ -743,8 +743,8 @@ begin
if UnsetBool(More, 0) then
begin
exclude(initmoduleswitches,cs_debuginfo);
exclude(initglobalswitches,cs_gdb_heaptrc);
exclude(initglobalswitches,cs_gdb_lineinfo);
exclude(initglobalswitches,cs_use_heaptrc);
exclude(initglobalswitches,cs_use_lineinfo);
exclude(initlocalswitches,cs_checkpointer);
end
else
@ -771,16 +771,16 @@ begin
'h' :
begin
if UnsetBool(More, j) then
exclude(initglobalswitches,cs_gdb_heaptrc)
exclude(initglobalswitches,cs_use_heaptrc)
else
include(initglobalswitches,cs_gdb_heaptrc);
include(initglobalswitches,cs_use_heaptrc);
end;
'l' :
begin
if UnsetBool(More, j) then
exclude(initglobalswitches,cs_gdb_lineinfo)
exclude(initglobalswitches,cs_use_lineinfo)
else
include(initglobalswitches,cs_gdb_lineinfo);
include(initglobalswitches,cs_use_lineinfo);
end;
's' :
begin

3
compiler/parser.pas
View File

@ -51,9 +51,6 @@ implementation
{$ifdef BrowserLog}
browlog,
{$endif BrowserLog}
{$ifdef GDB}
gdb,
{$endif GDB}
comphook,
scanner,scandir,
pbase,ptype,psystem,pmodules,psub,

24
compiler/pdecl.pas
View File

@ -279,9 +279,6 @@ implementation
again : boolean;
srsym : tsym;
srsymtable : tsymtable;
{$ifdef gdb_notused}
stab_str:Pchar;
{$endif gdb_notused}
begin
{ Check only typesyms or record/object fields }
@ -332,27 +329,6 @@ implementation
tpointerdef(pd).pointertype.setsym(srsym);
{ avoid wrong unused warnings web bug 801 PM }
inc(ttypesym(srsym).refs);
{$ifdef GDB_UNUSED}
if (cs_debuginfo in aktmoduleswitches) and assigned(al_debugtypes) and
(tsym(p).owner.symtabletype in [globalsymtable,staticsymtable]) then
begin
ttypesym(p).isusedinstab:=true;
{ ttypesym(p).concatstabto(al_debugtypes);}
{not stabs for forward defs }
if not Ttypesym(p).isstabwritten then
begin
if Ttypesym(p).restype.def.typesym=p then
Tstoreddef(Ttypesym(p).restype.def).concatstabto(al_debugtypes)
else
begin
stab_str:=Ttypesym(p).stabstring;
if assigned(stab_str) then
al_debugtypes.concat(Tai_stab.create(stab_stabs,stab_str));
Ttypesym(p).isstabwritten:=true;
end;
end;
end;
{$endif GDB_UNUSED}
{ we need a class type for classrefdef }
if (pd.deftype=classrefdef) and
not(is_class(ttypesym(srsym).restype.def)) then

6
compiler/pexpr.pas
View File

@ -851,7 +851,8 @@ implementation
getaddr:=true;
end
else
if (m_tp_procvar in aktmodeswitches) then
if (m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches) then
begin
aprocdef:=Tprocsym(sym).search_procdef_byprocvardef(getprocvardef);
if assigned(aprocdef) then
@ -931,7 +932,8 @@ implementation
begin
if not assigned(pv) then
internalerror(200301121);
if (m_tp_procvar in aktmodeswitches) then
if (m_tp_procvar in aktmodeswitches) or
(m_mac_procvar in aktmodeswitches) then
begin
hp:=p2;
hpp:=@p2;

181
compiler/pmodules.pas
View File

@ -42,21 +42,8 @@ implementation
link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
cresstr,procinfo,
dwarf,pexports,
{$ifdef GDB}
gdb,
{$endif GDB}
scanner,pbase,pexpr,psystem,psub,pdecsub;
(*
procedure fixseg(p:TAAsmoutput; sec:TAsmSectionType; secname: string);
begin
maybe_new_object_file(p);
if target_info.system <> system_powerpc_macos then
p.insert(Tai_section.Create(sec,'',0))
else
p.insert(Tai_section.Create(sec,secname,0));
end;
*)
procedure create_objectfile;
var
@ -103,7 +90,7 @@ implementation
{ Start and end of debuginfo, at least required for stabs
to insert n_sourcefile lines }
if (cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches) then
(cs_use_lineinfo in aktglobalswitches) then
begin
debuginfo.insertmodulestart(asmlist[al_debugstart]);
debuginfo.insertmoduleend(asmlist[al_debugend]);
@ -159,54 +146,6 @@ implementation
end;
(*
procedure insertsegment;
var
oldaktfilepos : tfileposinfo;
{Note: Sections get names in macos only.}
begin
{ Insert Ident of the compiler }
if (not (cs_create_smart in aktmoduleswitches))
{$ifndef EXTDEBUG}
and (not current_module.is_unit)
{$endif}
then
begin
{ align the first data }
asmlist[al_globals].insert(Tai_align.Create(const_align(32)));
asmlist[al_globals].insert(Tai_string.Create('FPC '+full_version_string+
' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
end;
{ align code segment }
asmlist[al_procedures].concat(Tai_align.create(aktalignment.procalign));
{ Insert start and end of sections }
fixseg(asmlist[al_procedures],sec_code,'____seg_code');
fixseg(asmlist[al_globals],sec_data,'____seg_data');
fixseg(asmlist[al_const],sec_rodata,'____seg_rodata');
// fixseg(asmlist[al_bss],sec_bss,'____seg_bss');
fixseg(asmlist[al_threadvars],sec_bss,'____seg_tbss');
{ we should use .rdata section for these two no ?
.rdata is a read only data section (PM) }
fixseg(asmlist[al_rtti],sec_data,'____seg_rtti');
fixseg(asmlist[al_typedconsts],sec_data,'____seg_consts');
fixseg(asmlist[al_rotypedconsts],sec_rodata,'____seg_consts');
fixseg(asmlist[al_picdata],sec_data,'____seg_al_picdata');
if assigned(asmlist[aasmtai.al_resourcestrings]) then
fixseg(asmlist[aasmtai.al_resourcestrings],sec_data,'____seg_resstrings');
{$ifdef GDB}
if assigned(asmlist[al_debugtypes]) then
begin
oldaktfilepos:=aktfilepos;
aktfilepos.line:=0;
asmlist[al_debugtypes].insert(Tai_symbol.Createname('gcc2_compiled',AT_DATA,0));
asmlist[al_debugtypes].insert(Tai_symbol.Createname('fpc_compiled',AT_DATA,0));
// fixseg(asmlist[al_debugtypes],sec_code,'____seg_debug');
aktfilepos:=oldaktfilepos;
end;
{$endif GDB}
end;
*)
{$ifndef segment_threadvars}
procedure InsertThreadvarTablesTable;
var
@ -513,10 +452,10 @@ implementation
if not(current_module.is_unit) then
begin
{ Heaptrc unit }
if (cs_gdb_heaptrc in aktglobalswitches) then
if (cs_use_heaptrc in aktglobalswitches) then
AddUnit('HeapTrc');
{ Lineinfo unit }
if (cs_gdb_lineinfo in aktglobalswitches) then
if (cs_use_lineinfo in aktglobalswitches) then
AddUnit('LineInfo');
{ Lineinfo unit }
if (cs_gdb_valgrind in aktglobalswitches) then
@ -700,87 +639,6 @@ implementation
end;
{$IfDef GDB}
procedure write_gdb_info;
procedure reset_unit_type_info;
var
hp : tmodule;
begin
hp:=tmodule(loaded_units.first);
while assigned(hp) do
begin
hp.is_stab_written:=false;
hp:=tmodule(hp.next);
end;
end;
procedure write_used_unit_type_info(hp:tmodule);
var
pu : tused_unit;
begin
pu:=tused_unit(hp.used_units.first);
while assigned(pu) do
begin
if not pu.u.is_stab_written then
begin
{ prevent infinte loop for circular dependencies }
pu.u.is_stab_written:=true;
{ write type info from used units, use a depth first
strategy to reduce the recursion in writing all
dependent stabs }
write_used_unit_type_info(pu.u);
if assigned(pu.u.globalsymtable) then
tglobalsymtable(pu.u.globalsymtable).concattypestabto(asmlist[al_debugtypes]);
end;
pu:=tused_unit(pu.next);
end;
end;
var
temptypestabs : taasmoutput;
storefilepos : tfileposinfo;
st : tsymtable;
begin
if not (cs_debuginfo in aktmoduleswitches) then
exit;
storefilepos:=aktfilepos;
aktfilepos:=current_module.mainfilepos;
{ include symbol that will be referenced from the program to be sure to
include this debuginfo .o file }
if current_module.is_unit then
begin
current_module.flags:=current_module.flags or uf_has_debuginfo;
st:=current_module.globalsymtable;
end
else
st:=current_module.localsymtable;
new_section(asmlist[al_debugtypes],sec_data,lower(st.name^),0);
asmlist[al_debugtypes].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',st,''),AT_DATA,0));
{ first write all global/local symbols again to a temp list. This will flag
all required tdefs. After that the temp list can be removed since the debuginfo is already
written to the stabs when the variables/consts were written }
{$warning Hack to get all needed types}
temptypestabs:=taasmoutput.create;
if assigned(current_module.globalsymtable) then
tglobalsymtable(current_module.globalsymtable).concatstabto(temptypestabs);
if assigned(current_module.localsymtable) then
tstaticsymtable(current_module.localsymtable).concatstabto(temptypestabs);
temptypestabs.free;
{ reset unit type info flag }
reset_unit_type_info;
{ write used types from the used units }
write_used_unit_type_info(current_module);
{ last write the types from this unit }
if assigned(current_module.globalsymtable) then
tglobalsymtable(current_module.globalsymtable).concattypestabto(asmlist[al_debugtypes]);
if assigned(current_module.localsymtable) then
tstaticsymtable(current_module.localsymtable).concattypestabto(asmlist[al_debugtypes]);
aktfilepos:=storefilepos;
end;
{$EndIf GDB}
procedure reset_all_defs;
procedure reset_used_unit_defs(hp:tmodule);
@ -968,18 +826,19 @@ implementation
procedure proc_unit;
function is_assembler_generated:boolean;
var
hal : tasmlist;
begin
is_assembler_generated:=(Errorcount=0) and
not(
asmlist[al_procedures].empty and
asmlist[al_globals].empty and
// asmlist[al_bss].empty and
asmlist[al_threadvars].empty and
asmlist[al_rtti].empty and
((asmlist[al_imports]=nil) or asmlist[al_imports].empty) and
((asmlist[al_resources]=nil) or asmlist[al_resources].empty) and
((asmlist[aasmtai.al_resourcestrings]=nil) or asmlist[aasmtai.al_resourcestrings].empty)
);
result:=false;
if Errorcount=0 then
begin
for hal:=low(Tasmlist) to high(Tasmlist) do
if not asmlist[hal].empty then
begin
result:=true;
exit;
end;
end;
end;
var
@ -1303,9 +1162,8 @@ implementation
maybeloadvariantsunit;
{ generate debuginfo }
{$ifdef GDB}
write_gdb_info;
{$endif GDB}
if (cs_debuginfo in aktmoduleswitches) then
debuginfo.insertmoduletypes(asmlist[al_debugtypes]);
{ generate wrappers for interfaces }
gen_intf_wrappers(asmlist[al_procedures],current_module.globalsymtable);
@ -1624,9 +1482,8 @@ implementation
maybeloadvariantsunit;
{ generate debuginfo }
{$ifdef GDB}
write_gdb_info;
{$endif GDB}
if (cs_debuginfo in aktmoduleswitches) then
debuginfo.insertmoduletypes(asmlist[al_debugtypes]);
{ generate wrappers for interfaces }
gen_intf_wrappers(asmlist[al_procedures],current_module.localsymtable);

13
compiler/pp.pas
View File

@ -22,9 +22,8 @@
program pp;
{
possible compiler switches (* marks a currently required switch):
possible compiler switches:
-----------------------------------------------------------------
GDB* support of the GNU Debugger
CMEM use cmem unit for better memory debugging
I386 generate a compiler for the Intel i386+
x86_64 generate a compiler for the AMD x86-64 architecture
@ -40,10 +39,6 @@ program pp;
MMX instructions
EXTERN_MSG Don't compile the msgfiles in the compiler, always
use external messagefiles, default for TP
NOAG386INT no Intel Assembler output
NOAG386NSM no NASM output
NOAG386BIN leaves out the binary writer, default for TP
NORA386DIR No direct i386 assembler reader
TEST_GENERIC Test Generic version of code generator
(uses generic RTL calls)
-----------------------------------------------------------------
@ -54,16 +49,12 @@ program pp;
-----------------------------------------------------------------
Required switches for a i386 compiler be compiled by Free Pascal Compiler:
GDB;I386
I386
}
{$i fpcdefs.inc}
{$ifdef FPC}
{$ifndef GDB}
{ people can try to compile without GDB }
{ $error The compiler switch GDB must be defined}
{$endif GDB}
{ exactly one target CPU must be defined }
{$ifdef I386}
{$ifdef CPUDEFINED}

2
compiler/psub.pas
View File

@ -855,7 +855,7 @@ implementation
{ insert line debuginfo }
if (cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches) then
(cs_use_lineinfo in aktglobalswitches) then
debuginfo.insertlineinfo(aktproccode);
{ add the procedure to the al_procedures }

7
compiler/ptconst.pas
View File

@ -46,7 +46,7 @@ implementation
{ parser specific stuff }
pbase,pexpr,
{ codegen }
cpuinfo,cgbase
cpuinfo,cgbase,dbgbase
;
{$ifdef fpc}
@ -125,10 +125,9 @@ implementation
maybe_new_object_file(asmlist[cural]);
new_section(asmlist[cural],cursectype,lower(sym.mangledname),const_align(l));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
sym.concatstabto(asmlist[cural]);
{$endif GDB}
debuginfo.insertsym(asmlist[cural],sym);
if (sym.owner.symtabletype=globalsymtable) or
maybe_smartlink_symbol or
(assigned(current_procinfo) and

2
compiler/switches.pas
View File

@ -177,7 +177,7 @@ begin
begin
{ Turning off debuginfo when lineinfo is requested
is not possible }
if not((cs_gdb_lineinfo in aktglobalswitches) and
if not((cs_use_lineinfo in aktglobalswitches) and
(tmoduleswitch(setsw)=cs_debuginfo)) then
exclude(aktmoduleswitches,tmoduleswitch(setsw));
end;

16
compiler/symbase.pas
View File

@ -41,11 +41,6 @@ interface
hasharraysize = 256;
indexgrowsize = 64;
{$ifdef GDB}
memsizeinc = 4096; { for long stabstrings }
{$endif GDB}
{************************************************
Needed forward pointers
************************************************}
@ -127,9 +122,6 @@ interface
{$endif EXTDEBUG}
function getdefnr(l : longint) : tdefentry;
function getsymnr(l : longint) : tsymentry;
{$ifdef GDB}
function getnewtypecount : word; virtual;
{$endif GDB}
end;
var
@ -338,12 +330,4 @@ implementation
end;
{$ifdef GDB}
function tsymtable.getnewtypecount : word;
begin
getnewtypecount:=0;
end;
{$endif GDB}
end.

14
compiler/symconst.pas
View File

@ -392,8 +392,6 @@ type
te_exact
);
{$ifdef GDB}
type
tdefstabstatus = (
stab_state_unused,
stab_state_used,
@ -401,18 +399,6 @@ type
stab_state_written
);
const
tagtypes : Set of tdeftype =
[recorddef,enumdef,
{$IfNDef GDBKnowsStrings}
stringdef,
{$EndIf not GDBKnowsStrings}
{$IfNDef GDBKnowsFiles}
filedef,
{$EndIf not GDBKnowsFiles}
objectdef];
{$endif GDB}
const
inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected,

1110
compiler/symdef.pas
View File

File diff suppressed because it is too large Load Diff

340
compiler/symsym.pas
View File

@ -47,12 +47,6 @@ interface
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);virtual;
{$ifdef GDB}
function get_var_value(const s:string):string;
function stabstr_evaluate(const s:string;vars:array of string):Pchar;
procedure concatstabto(asmlist : taasmoutput);
{$endif GDB}
function mangledname : string; virtual;
end;
tlabelsym = class(tstoredsym)
@ -69,9 +63,6 @@ interface
constructor create(const n : string);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tunitsym = class(Tstoredsym)
@ -127,9 +118,6 @@ interface
context is the object def we're really in, this is for the strict stuff
}
function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
ttypesym = class(Tstoredsym)
@ -142,9 +130,6 @@ interface
function gettypedef:tdef;override;
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
function write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tabstractvarsym = class(tstoredsym)
@ -177,9 +162,6 @@ interface
constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tabstractnormalvarsym = class(tabstractvarsym)
@ -197,9 +179,6 @@ interface
constructor create(const n : string;vsp:tvarspez;const tt : ttype;vopts:tvaroptions);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tparavarsym = class(tabstractnormalvarsym)
@ -212,9 +191,6 @@ interface
constructor ppuload(ppufile:tcompilerppufile);
destructor destroy;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tglobalvarsym = class(tabstractnormalvarsym)
@ -229,9 +205,6 @@ interface
procedure ppuwrite(ppufile:tcompilerppufile);override;
function mangledname:string;override;
procedure set_mangledname(const s:string);
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tabsolutevarsym = class(tabstractvarsym)
@ -251,9 +224,6 @@ interface
procedure deref;override;
function mangledname : string;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef gdb}
function stabstring:Pchar;override;
{$endif gdb}
end;
tpropertysym = class(Tstoredsym)
@ -293,9 +263,6 @@ interface
procedure buildderef;override;
procedure deref;override;
function getsize:longint;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tconstvalue = record
@ -320,9 +287,6 @@ interface
procedure buildderef;override;
procedure deref;override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
{$ifdef GDB}
function stabstring : pchar;override;
{$endif GDB}
end;
tenumsym = class(Tstoredsym)
@ -401,9 +365,6 @@ implementation
{ tree }
node,
{ aasm }
{$ifdef gdb}
gdb,
{$endif gdb}
{ codegen }
paramgr,cresstr,
procinfo
@ -445,9 +406,7 @@ implementation
refs:=0;
lastwritten:=nil;
refcount:=0;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
end;
@ -476,39 +435,6 @@ implementation
inherited destroy;
end;
{$ifdef GDB}
function Tstoredsym.get_var_value(const s:string):string;
begin
if s='mangledname' then
get_var_value:=mangledname
else
get_var_value:=inherited get_var_value(s);
end;
function Tstoredsym.stabstr_evaluate(const s:string;vars:array of string):Pchar;
begin
stabstr_evaluate:=string_evaluate(s,@get_var_value,vars);
end;
procedure tstoredsym.concatstabto(asmlist : taasmoutput);
var
stabstr : Pchar;
begin
stabstr:=stabstring;
if stabstr<>nil then
asmlist.concat(Tai_stab.create(stab_stabs,stabstr));
end;
{$endif GDB}
function tstoredsym.mangledname : string;
begin
internalerror(200204171);
end;
{****************************************************************************
TLABELSYM
@ -546,14 +472,6 @@ implementation
end;
{$ifdef GDB}
function Tlabelsym.stabstring : pchar;
begin
stabstring:=stabstr_evaluate('"${name}",${N_LSYM},0,${line},0',[]);
end;
{$endif GDB}
{****************************************************************************
TUNITSYM
****************************************************************************}
@ -1130,14 +1048,6 @@ implementation
end;
{$ifdef GDB}
function tprocsym.stabstring : pchar;
begin
internalerror(200111171);
result:=nil;
end;
{$endif GDB}
{****************************************************************************
TERRORSYM
@ -1489,26 +1399,6 @@ implementation
ppufile.writeentry(ibfieldvarsym);
end;
{$ifdef GDB}
function tfieldvarsym.stabstring:Pchar;
var
st : string;
begin
stabstring:=nil;
case owner.symtabletype of
objectsymtable :
begin
if (sp_static in symoptions) then
begin
st:=tstoreddef(vartype.def).numberstring;
st:='S'+st;
stabstring:=stabstr_evaluate('"${ownername}__${name}:$1",${N_LCSYM},0,${line},${mangledname}',[st]);
end;
end;
end;
end;
{$endif GDB}
{****************************************************************************
TABSTRACTNORMALVARSYM
@ -1638,47 +1528,6 @@ implementation
end;
{$ifdef GDB}
function Tglobalvarsym.stabstring:Pchar;
var st:string;
threadvaroffset:string;
regidx:Tregisterindex;
begin
result:=nil;
st:=tstoreddef(vartype.def).numberstring;
case localloc.loc of
LOC_REGISTER,
LOC_CREGISTER,
LOC_MMREGISTER,
LOC_CMMREGISTER,
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
if regidx<>0 then
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
else
begin
if (vo_is_thread_var in varoptions) then
threadvaroffset:='+'+tostr(sizeof(aint))
else
threadvaroffset:='';
{ Here we used S instead of
because with G GDB doesn't look at the address field
but searches the same name or with a leading underscore
but these names don't exist in pascal !}
st:='S'+st;
stabstring:=stabstr_evaluate('"${name}:$1",${N_LCSYM},0,${line},${mangledname}$2',[st,threadvaroffset]);
end;
end;
end;
{$endif GDB}
{****************************************************************************
TLOCALVARSYM
****************************************************************************}
@ -1704,42 +1553,6 @@ implementation
end;
{$ifdef GDB}
function tlocalvarsym.stabstring:Pchar;
var st:string;
regidx:Tregisterindex;
begin
stabstring:=nil;
{ There is no space allocated for not referenced locals }
if (owner.symtabletype=localsymtable) and (refs=0) then
exit;
st:=tstoreddef(vartype.def).numberstring;
case localloc.loc of
LOC_REGISTER,
LOC_CREGISTER,
LOC_MMREGISTER,
LOC_CMMREGISTER,
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
if regidx<>0 then
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(regstabs_table[regidx])]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end;
end;
{$endif GDB}
{****************************************************************************
TPARAVARSYM
****************************************************************************}
@ -1796,85 +1609,6 @@ implementation
ppufile.writeentry(ibparavarsym);
end;
{$ifdef GDB}
function tparavarsym.stabstring:Pchar;
var st:string;
regidx:Tregisterindex;
c:char;
begin
result:=nil;
{ set loc to LOC_REFERENCE to get somewhat usable debugging info for -Or }
{ while stabs aren't adapted for regvars yet }
if (vo_is_self in varoptions) then
begin
case localloc.loc of
LOC_REGISTER,
LOC_CREGISTER:
regidx:=findreg_by_number(localloc.register);
LOC_REFERENCE: ;
else
internalerror(2003091815);
end;
if (po_classmethod in current_procinfo.procdef.procoptions) or
(po_staticmethod in current_procinfo.procdef.procoptions) then
begin
if (localloc.loc=LOC_REFERENCE) then
stabstring:=stabstr_evaluate('"pvmt:p$1",${N_TSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(localloc.reference.offset)]);
(* else
stabstring:=stabstr_evaluate('"pvmt:r$1",${N_RSYM},0,0,$2',
[Tstoreddef(pvmttype.def).numberstring,tostr(regstabs_table[regidx])]) *)
end
else
begin
if not(is_class(current_procinfo.procdef._class)) then
c:='v'
else
c:='p';
if (localloc.loc=LOC_REFERENCE) then
stabstring:=stabstr_evaluate('"$$t:$1",${N_TSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(localloc.reference.offset)]);
(* else
stabstring:=stabstr_evaluate('"$$t:r$1",${N_RSYM},0,0,$2',
[c+current_procinfo.procdef._class.numberstring,tostr(regstabs_table[regidx])]); *)
end;
end
else
begin
st:=tstoreddef(vartype.def).numberstring;
if paramanager.push_addr_param(varspez,vartype.def,tprocdef(owner.defowner).proccalloption) and
not(vo_has_local_copy in varoptions) and
not is_open_string(vartype.def) then
st := 'v'+st { should be 'i' but 'i' doesn't work }
else
st := 'p'+st;
case localloc.loc of
LOC_REGISTER,
LOC_CREGISTER,
LOC_MMREGISTER,
LOC_CMMREGISTER,
LOC_FPUREGISTER,
LOC_CFPUREGISTER :
begin
regidx:=findreg_by_number(localloc.register);
{ "eax", "ecx", "edx", "ebx", "esp", "ebp", "esi", "edi", "eip", "ps", "cs", "ss", "ds", "es", "fs", "gs", }
{ this is the register order for GDB}
if regidx<>0 then
stabstring:=stabstr_evaluate('"${name}:r$1",${N_RSYM},0,${line},$2',[st,tostr(longint(regstabs_table[regidx]))]);
end;
LOC_REFERENCE :
{ offset to ebp => will not work if the framepointer is esp
so some optimizing will make things harder to debug }
stabstring:=stabstr_evaluate('"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(localloc.reference.offset)])
else
internalerror(2003091814);
end;
end;
end;
{$endif GDB}
{****************************************************************************
TABSOLUTEVARSYM
@ -1981,14 +1715,6 @@ implementation
end;
{$ifdef GDB}
function tabsolutevarsym.stabstring:Pchar;
begin
stabstring:=nil;
end;
{$endif GDB}
{****************************************************************************
TTYPEDCONSTSYM
*****************************************************************************}
@ -2080,19 +1806,6 @@ implementation
end;
{$ifdef GDB}
function ttypedconstsym.stabstring : pchar;
var st:char;
begin
st:='S';
stabstring:=stabstr_evaluate('"${name}:$1$2",${N_STSYM},0,${line},${mangledname}',
[st,Tstoreddef(typedconsttype.def).numberstring]);
end;
{$endif GDB}
{****************************************************************************
TCONSTSYM
****************************************************************************}
@ -2301,40 +2014,6 @@ implementation
ppufile.writeentry(ibconstsym);
end;
{$ifdef GDB}
function Tconstsym.stabstring:Pchar;
var st : string;
begin
{even GDB v4.16 only now 'i' 'r' and 'e' !!!}
case consttyp of
conststring:
st:='s'''+backspace_quote(octal_quote(strpas(pchar(value.valueptr)),[#0..#9,#11,#12,#14..#31,'''']),['"','\',#10,#13])+'''';
constord:
st:='i'+tostr(value.valueord);
constpointer:
st:='i'+tostr(value.valueordptr);
constreal:
begin
system.str(pbestreal(value.valueptr)^,st);
st := 'r'+st;
end;
{ if we don't know just put zero !! }
else st:='i0';
{***SETCONST}
{constset:;} {*** I don't know what to do with a set.}
{ sets are not recognized by GDB}
{***}
end;
{ valgrind does not support constants }
if cs_gdb_valgrind in aktglobalswitches then
stabstring:=nil
else
stabstring:=stabstr_evaluate('"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]);
end;
{$endif GDB}
{****************************************************************************
TENUMSYM
@ -2513,25 +2192,6 @@ implementation
end;
{$ifdef GDB}
function ttypesym.stabstring : pchar;
var stabchar:string[2];
begin
stabstring:=nil;
if restype.def<>nil then
begin
if restype.def.deftype in tagtypes then
stabchar:='Tt'
else
stabchar:='t';
stabstring:=stabstr_evaluate('"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,tstoreddef(restype.def).numberstring]);
end;
end;
{$endif GDB}
{****************************************************************************
TSYSSYM
****************************************************************************}

102
compiler/symtable.pas
View File

@ -78,10 +78,6 @@ interface
procedure checklabels;
function needs_init_final : boolean;
procedure unchain_overloaded;
{$ifdef GDB}
procedure concatstabto(asmlist : taasmoutput);virtual;
function getnewtypecount : word; override;
{$endif GDB}
procedure testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
end;
@ -133,9 +129,6 @@ interface
tabstractunitsymtable = class(tstoredsymtable)
public
constructor create(const n : string;id:word);
{$ifdef GDB}
procedure concattypestabto(asmlist : taasmoutput);
{$endif GDB}
function iscurrentunit:boolean;override;
end;
@ -148,9 +141,6 @@ interface
procedure load_references(ppufile:tcompilerppufile;locals:boolean);override;
procedure write_references(ppufile:tcompilerppufile;locals:boolean);override;
procedure insert(sym : tsymentry);override;
{$ifdef GDB}
function getnewtypecount : word; override;
{$endif}
end;
tstaticsymtable = class(tabstractunitsymtable)
@ -274,9 +264,6 @@ implementation
symutil,defcmp,
{ module }
fmodule,
{$ifdef GDB}
gdb,
{$endif GDB}
{ codegen }
procinfo
;
@ -830,15 +817,6 @@ implementation
end;
{$ifdef GDB}
function tstoredsymtable.getnewtypecount : word;
begin
getnewtypecount:=pglobaltypecount^;
inc(pglobaltypecount^);
end;
{$endif GDB}
{***********************************************
Process all entries
***********************************************}
@ -880,32 +858,6 @@ implementation
end;
{$ifdef GDB}
procedure tstoredsymtable.concatstabto(asmlist : taasmoutput);
var
stabstr : Pchar;
p : tsym;
begin
p:=tsym(symindex.first);
while assigned(p) do
begin
{ Procsym and typesym are already written }
if not(Tsym(p).typ in [procsym,typesym]) then
begin
if not Tsym(p).isstabwritten then
begin
stabstr:=Tsym(p).stabstring;
if stabstr<>nil then
asmlist.concat(Tai_stab.create(stab_stabs,stabstr));
Tsym(p).isstabwritten:=true;
end;
end;
p:=tsym(p.indexnext);
end;
end;
{$endif}
procedure TStoredSymtable._needs_init_final(p : tnamedindexitem;arg:pointer);
begin
if b_needs_init_final then
@ -1359,48 +1311,6 @@ implementation
end;
{$ifdef GDB}
procedure tabstractunitsymtable.concattypestabto(asmlist : taasmoutput);
procedure dowritestabs(asmlist:taasmoutput;st:tsymtable);
var
p : tstoreddef;
begin
p:=tstoreddef(st.defindex.first);
while assigned(p) do
begin
{ also insert local types for the current unit }
if iscurrentunit then
begin
case p.deftype of
procdef :
if assigned(tprocdef(p).localst) then
dowritestabs(asmlist,tprocdef(p).localst);
objectdef :
dowritestabs(asmlist,tobjectdef(p).symtable);
end;
end;
if (p.stab_state=stab_state_used) then
p.concatstabto(asmlist);
p:=tstoreddef(p.indexnext);
end;
end;
var
old_writing_def_stabs : boolean;
begin
if not assigned(name) then
name := stringdup('Main_program');
asmList.concat(tai_comment.Create(strpnew('Begin unit '+name^+' has index '+tostr(moduleid))));
old_writing_def_stabs:=writing_def_stabs;
writing_def_stabs:=true;
dowritestabs(asmlist,self);
writing_def_stabs:=old_writing_def_stabs;
asmList.concat(tai_comment.Create(strpnew('End unit '+name^+' has index '+tostr(moduleid))));
end;
{$endif GDB}
{****************************************************************************
TStaticSymtable
****************************************************************************}
@ -1540,14 +1450,6 @@ implementation
end;
{$ifdef GDB}
function tglobalsymtable.getnewtypecount : word;
begin
getnewtypecount:=inherited getnewtypecount
end;
{$endif}
{****************************************************************************
TWITHSYMTABLE
****************************************************************************}
@ -2357,10 +2259,6 @@ implementation
symtablestack:=nil;
macrosymtablestack:=nil;
systemunit:=nil;
{$ifdef GDB}
globaltypecount:=1;
pglobaltypecount:=@globaltypecount;
{$endif GDB}
{ create error syms and def }
generrorsym:=terrorsym.create;
generrortype.setdef(terrordef.create);

59
compiler/symtype.pas
View File

@ -69,6 +69,9 @@ interface
tdef = class(tdefentry)
typesym : tsym; { which type the definition was generated this def }
{ stabs debugging }
stab_number : word;
stab_state : tdefstabstatus;
defoptions : tdefoptions;
constructor create;
procedure buildderef;virtual;abstract;
@ -105,15 +108,11 @@ interface
defref,
lastwritten : tref;
refcount : longint;
{$ifdef GDB}
isstabwritten : boolean;
function get_var_value(const s:string):string;
function stabstr_evaluate(const s:string;vars:array of string):Pchar;
function stabstring : pchar;virtual;
{$endif GDB}
constructor create(const n : string);
destructor destroy;override;
function realname:string;
function mangledname:string; virtual;
procedure buildderef;virtual;
procedure deref;virtual;
function gettypedef:tdef;virtual;
@ -231,9 +230,6 @@ implementation
uses
verbose,
fmodule
{$ifdef GDB}
,gdb
{$endif GDB}
;
@ -326,9 +322,7 @@ implementation
inc(refcount);
end;
lastref:=defref;
{$ifdef GDB}
isstabwritten := false;
{$endif GDB}
symoptions:=current_object_option;
end;
@ -355,45 +349,6 @@ implementation
begin
end;
{$ifdef GDB}
function Tsym.get_var_value(const s:string):string;
begin
if s='name' then
get_var_value:=name
else if s='ownername' then
get_var_value:=owner.name^
else if s='line' then
get_var_value:=tostr(fileinfo.line)
else if s='N_LSYM' then
get_var_value:=tostr(N_LSYM)
else if s='N_LCSYM' then
get_var_value:=tostr(N_LCSYM)
else if s='N_RSYM' then
get_var_value:=tostr(N_RSYM)
else if s='N_TSYM' then
get_var_value:=tostr(N_TSYM)
else if s='N_STSYM' then
get_var_value:=tostr(N_STSYM)
else if s='N_FUNCTION' then
get_var_value:=tostr(N_FUNCTION)
else
internalerror(200401152);
end;
function Tsym.stabstr_evaluate(const s:string;vars:array of string):Pchar;
begin
stabstr_evaluate:=string_evaluate(s,@get_var_value,vars);
end;
function Tsym.stabstring : pchar;
begin
stabstring:=nil;
end;
{$endif GDB}
function tsym.realname : string;
begin
@ -404,6 +359,12 @@ implementation
end;
function tsym.mangledname : string;
begin
internalerror(200204171);
end;
function tsym.gettypedef:tdef;
begin
gettypedef:=nil;

28
compiler/systems/t_win.pas
View File

@ -31,9 +31,6 @@ interface
symconst,symdef,symsym,
script,gendef,
cpubase,
{$ifdef GDB}
gdb,
{$endif}
import,export,link,cgobj,i_win;
@ -100,7 +97,7 @@ interface
implementation
uses
cpuinfo,cgutils;
cpuinfo,cgutils,dbgbase;
const
@ -232,7 +229,6 @@ implementation
var
hp1 : timportlist;
hp2 : twin32imported_item;
p : pchar;
begin
new_section(asmlist[al_imports],sec_code,'',0);
hp1:=timportlist(current_module.imports.first);
@ -254,10 +250,8 @@ implementation
var
hp1 : timportlist;
mangledstring : string;
{$ifdef GDB}
importname : string;
suffix : integer;
{$endif GDB}
hp2 : twin32imported_item;
lhead,lname,lcode, {$ifdef ARM} lpcode, {$endif ARM}
lidata4,lidata5 : tasmlabel;
@ -333,10 +327,9 @@ implementation
asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
asmlist[al_imports].concat(Tai_align.Create_op(4,$90));
{$endif ARM}
{$IfDef GDB}
if (cs_debuginfo in aktmoduleswitches) and assigned(hp2.procdef) then
hp2.procdef.concatstabto(asmlist[al_imports]);
{$EndIf GDB}
if (cs_debuginfo in aktmoduleswitches) and
assigned(hp2.procdef) then
debuginfo.insertdef(asmlist[al_imports],hp2.procdef);
end;
{ create head link }
new_section(asmlist[al_imports],sec_idata7,'',0);
@ -351,7 +344,6 @@ implementation
asmlist[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0))
else
asmlist[al_imports].concat(Tai_label.Create(lcode));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if assigned(hp2.name) then
@ -377,7 +369,6 @@ implementation
asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end;
end;
{$endif GDB}
if hp2.name^<>'' then
asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab))
else
@ -415,10 +406,8 @@ implementation
hp2 : twin32imported_item;
l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
mangledstring : string;
{$ifdef GDB}
importname : string;
suffix : integer;
{$endif GDB}
href : treference;
begin
if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
@ -500,13 +489,11 @@ implementation
asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
asmlist[al_imports].concat(Tai_align.Create_op(4,$90));
{$endif ARM}
{$IfDef GDB}
if (cs_debuginfo in aktmoduleswitches) and assigned(hp2.procdef) then
hp2.procdef.concatstabto(asmlist[al_imports]);
{$EndIf GDB}
if (cs_debuginfo in aktmoduleswitches) and
assigned(hp2.procdef) then
debuginfo.insertdef(asmlist[al_imports],hp2.procdef);
{ add jump field to al_imports }
new_section(asmlist[al_imports],sec_idata5,'',0);
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
if assigned(hp2.name) then
@ -532,7 +519,6 @@ implementation
asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
end;
end;
{$endif GDB}
asmlist[al_imports].concat(Tai_label.Create(l4));
end
else