fpc/compiler/gdb.pas
2001-10-12 16:05:36 +00:00

319 lines
8.4 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 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 defines.inc}
interface
uses
{$ifdef delphi}
sysutils,
{$else}
strings,
{$endif}
globtype,cpubase,
globals,aasm;
{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;
type
tai_stabs = class(tai)
str : pchar;
constructor Create(_str : pchar);
destructor Destroy;override;
end;
tai_stabn = class(tai)
str : pchar;
constructor Create(_str : pchar);
destructor Destroy;override;
end;
{ insert a cut to split into several smaller files }
tai_force_line = class(tai)
constructor Create;
end;
tai_stab_function_name = class(tai)
str : pchar;
constructor create(_str : pchar);
destructor destroy;override;
end;
const
DBX_counter : plongint = nil;
do_count_dbx : boolean = false;
{$ifdef i386}
{ this is the register order for GDB }
{ 0 "eax", "ecx", "edx", "ebx", \
4 "esp", "ebp", "esi", "edi", \
8 "eip", "eflags", "cs", "ss", \
12 "ds", "es", "fs", "gs", \
16 "st0", "st1", "st2", "st3", \
20 "st4", "st5", "st6", "st7", \
24 "fctrl", "fstat", "ftag", "fiseg", \
28 "fioff", "foseg", "fooff", "fop", \
32 "xmm0", "xmm1", "xmm2", "xmm3", \
36 "xmm4", "xmm5", "xmm6", "xmm7", \
40 "mxcsr" \
}
{ tregister = (R_NO,
R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
R_AL,R_CL,R_DL,R_BL,R_AH,R_CH,R_BH,R_DH,
R_CS,R_DS,R_ES,R_SS,R_FS,R_GS,
R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7,
R_DR0,R_DR1,R_DR2,R_DR3,R_DR6,R_DR7,
R_CR0,R_CR2,R_CR3,R_CR4,
R_TR3,R_TR4,R_TR5,R_TR6,R_TR7,
R_MM0,R_MM1,R_MM2,R_MM3,R_MM4,R_MM5,R_MM6,R_MM7,
R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7
); }
GDB_i386index : array[tregister] of shortint =(-1,
0,1,2,3,4,5,6,7,
0,1,2,3,4,5,6,7,
0,1,2,3,0,1,2,3,
10,12,13,11,14,15,
16,16,17,18,19,20,21,22,23,
-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,
-1,-1,-1,-1,-1,
{ I think, GDB doesn't know MMX (FK) }
16,17,18,19,20,21,22,23,
32,33,34,35,36,37,38,39
);
{$endif i386}
{$ifdef m68k}
{ "d0", "d1", "d2", "d3", "d4", "d5", "d6", "d7",
"a0", "a1", "a2", "a3", "a4", "a5", "fp", "sp",
"ps", "pc", "fp0", "fp1", "fp2", "fp3", "fp4" ,
"fp5", "fp6", "fp7", "fpcontrol", "fpstatus",
"fpiaddr","fpcode","fpflags"
}
{ this is the register order for GDB }
GDB_m68kindex : array[tregister] of shortint =
(-1, { R_NO }
0,1,2,3,4,5,6,7, { R_D0..R_D7 }
8,9,10,11,12,13,14,15, { R_A0..R_A7 }
-1,-1,-1, { R_SPPUSH, R_SPPULL, R_CCR }
18,19,20,21,22,23,24,25, { R_FP0..R_FP7 }
-1,-1,-1,-1,-1,-1,-1,-1
);
{$endif}
implementation
{ to use N_EXCL we have to count the character in the stabs for
N_BINCL to N_EINCL
Code comes from stabs.c for ld
if (type == N_BINCL)
(
bfd_vma val;
int nest;
bfd_byte *incl_sym;
struct stab_link_includes_entry *incl_entry;
struct stab_link_includes_totals *t;
struct stab_excl_list *ne;
val = 0;
nest = 0;
for (incl_sym = sym + STABSIZE;
incl_sym < symend;
incl_sym += STABSIZE)
(
int incl_type;
incl_type = incl_sym[TYPEOFF];
if (incl_type == 0)
break;
else if (incl_type == N_EINCL)
(
if (nest == 0)
break;
--nest;
)
else if (incl_type == N_BINCL)
++nest;
else if (nest == 0)
(
const char *str;
str = ((char *) stabstrbuf
+ stroff
+ bfd_get_32 (abfd, incl_sym + STRDXOFF));
for (; *str != '\0'; str++)
(
val += *str;
if *str == '('
(
Skip the file number.
++str;
while (isdigit ((unsigned char) *str))
++str;
--str;
)
)
)
) }
procedure count_dbx(st : pchar);
var i : longint;
do_count : boolean;
begin
do_count := false;
if assigned(dbx_counter) then
begin
{$IfDef ExtDebugDbx }
Comment(V_Info,'Counting '+st);
Comment(V_Info,'count = '+tostr(dbx_counter^));
Comment(V_Info,'addr = '+tostr(longint(dbx_counter)));
{$EndIf ExtDebugDbx }
i:=0;
while i<=strlen(st) do
begin
if st[i] = '"' then
if do_count then exit
else do_count := true
else
if do_count then
begin
dbx_counter^ := dbx_counter^+byte(st[i]);
{ skip file number }
if st[i] = '(' then
begin
inc(i);
while st[i] in ['0'..'9'] do inc(i);
dec(i);
end;
end;
inc(i);
end;
end;
end;
constructor tai_stabs.create(_str : pchar);
begin
inherited create;
typ:=ait_stabs;
str:=_str;
if do_count_dbx then
begin
count_dbx(str);
end;
end;
destructor tai_stabs.destroy;
begin
strdispose(str);
inherited destroy;
end;
constructor tai_stabn.create(_str : pchar);
begin
inherited create;
typ:=ait_stabn;
str:=_str;
end;
destructor tai_stabn.destroy;
begin
strdispose(str);
inherited destroy;
end;
constructor tai_force_line.create;
begin
inherited create;
typ:=ait_force_line;
end;
constructor tai_stab_function_name.create(_str : pchar);
begin
inherited create;
typ:=ait_stab_function_name;
str:=_str;
end;
destructor tai_stab_function_name.destroy;
begin
strdispose(str);
inherited destroy;
end;
end.
{
$Log$
Revision 1.8 2001-10-12 16:05:36 peter
* more registers (merged)
Revision 1.7 2001/04/21 12:03:11 peter
* m68k updates merged from fixes branch
Revision 1.6 2001/04/13 01:22:07 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.5 2000/12/25 00:07:26 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.4 2000/11/29 00:30:30 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.3 2000/09/24 15:06:16 peter
* use defines.inc
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}