+ Add support for GDB 7.0.

git-svn-id: trunk@14021 -

packages/gdbint/src/gdbint.pp

@@ -13,14 +13,25 @@
  **********************************************************************}
 unit GdbInt;
 
-{$i gdbver.inc}
+{$mode objfpc}
+
+{$ifdef USE_GDBLIBINC}
+  {$i gdblib.inc}
+{$else not USE_GDBLIBINC}
+  {$i gdbver.inc}
+{$endif not USE_GDBLIBINC}
+
+{ Possible optional conditionals:
+  GDB_DISABLE_INTL              To explicitly not use libintl
+  GDB_CORE_ADDR_FORCE_64BITS    To force 64 bits for CORE_ADDR
+  Verbose                       To test gdbint
+  DebugCommand                  To debug Command method
+}
 
 interface
 
 {$smartlink off}
 
-{.$define Verbose}
-{.$define DebugCommand}
 {$define NotImplemented}
 
 { Is create_breakpoint_hook deprecated? }
@@ -72,7 +83,7 @@ interface
   {$define GDB_NEEDS_NO_ERROR_INIT}
   {$define GDB_USES_EXPAT_LIB}
   {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
-{$endif def GDB_V605}
+{$endif def GDB_V606}
 
 { 6.7.x }
 {$ifdef GDB_V607}
@@ -82,8 +93,44 @@ interface
   {$define GDB_NEEDS_NO_ERROR_INIT}
   {$define GDB_USES_EXPAT_LIB}
   {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
-{$endif def GDB_V605}
+{$endif def GDB_V607}
+
+<<<<<<< .mine
+{ 6.8.x }
+{$ifdef GDB_V608}
+  {$info using gdb 6.8.x}
+  {$define GDB_V6}
+  {$define GDB_HAS_DB_COMMANDS}
+  {$define GDB_NEEDS_NO_ERROR_INIT}
+  {$define GDB_USES_EXPAT_LIB}
+  {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
+  {$define GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+  {$define GDB_HAS_BP_NONE}
+{$endif def GDB_V608}
+
+
+{ 7.0.x }
+{$ifdef GDB_V700}
+  {$info using gdb 7.0.x}
+  {$define GDB_V7}
+{$endif def GDB_V700}
+
+{$ifdef GDB_V7}
+  {$define GDB_V6}
+  {$define GDB_HAS_DB_COMMANDS}
+  {$define GDB_NEEDS_NO_ERROR_INIT}
+  {$define GDB_USES_EXPAT_LIB}
+  {$define GDB_USES_LIBDECNUMBER}
+  {$define GDB_USES_LIBINTL}
+  {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
+  {$define GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+  {$define GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
+  {$define GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
+  {$define GDB_HAS_BP_NONE}
+{$endif def GDB_V7}
+
 
+=======
 { 6.8.x }
 {$ifdef GDB_V608}
   {$info using gdb 6.8.x}
@@ -94,6 +141,7 @@ interface
   {$define GDB_HAS_DEBUG_FILE_DIRECTORY}
 {$endif def GDB_V608}
 
+>>>>>>> .r14018
 {$ifdef GDB_V6}
   {$define GDB_HAS_SYSROOT}
   {$define GDB_HAS_DB_COMMANDS}
@@ -101,12 +149,18 @@ interface
   {$define GDB_INIT_HAS_ARGV0}
 {$endif GDB_V6}
 
+
+{$ifdef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+  {$define DO_NOT_USE_CBPH}
+{$endif}
+
 { GDB has a simulator for powerpc CPU
   it is integrated into GDB by default }
 {$ifdef cpupowerpc}
   {$define GDB_HAS_SIM}
 {$endif cpupowerpc}
 
+{$ifdef NotImplemented}
 {$ifdef go32v2}
   {$undef NotImplemented}
   {$LINKLIB gdb}
@@ -118,7 +172,15 @@ interface
   {$LINKLIB opcodes}
   {$LINKLIB history}
   {$LINKLIB iberty}
-  {$LINKLIB intl}
+  {$ifdef GDB_USES_LIBDECNUMBER}
+    {$LINKLIB decnumber}
+  {$endif GDB_USES_LIBDECNUMBER}
+  {$ifdef GDB_USES_EXPAT_LIB}
+    {$LINKLIB expat}
+  {$endif GDB_USES_EXPAT_LIB}
+  {$ifndef GDB_DISABLE_INTL}
+    {$LINKLIB intl}
+  {$endif ndef GDB_DISABLE_INTL}
   {$LINKLIB dbg}
   {$LINKLIB c}
 {$endif go32v2}
@@ -161,7 +223,10 @@ interface
   {$LINKLIB ncurses}
   {$LINKLIB m}
   {$LINKLIB iberty}
-  {$LINKLIB intl}        { does not seem to exist on netbsd LINKLIB dl,
+  {$ifndef GDB_DISABLE_INTL}
+    {$LINKLIB intl}
+  {$endif ndef GDB_DISABLE_INTL}
+     { does not seem to exist on netbsd LINKLIB dl,
                             but I use GDB CVS snapshots for the *BSDs}
   {$ifdef GDB_USES_EXPAT_LIB}
     {$LINKLIB expat}
@@ -207,7 +272,9 @@ interface
   {$LINKLIB ncurses}
   {$LINKLIB m}
   {$LINKLIB iberty}
-  {$LINKLIB intl}
+  {$ifndef GDB_DISABLE_INTL}
+    {$LINKLIB intl}
+  {$endif ndef GDB_DISABLE_INTL}
   {$ifdef GDB_USES_EXPAT_LIB}
     {$LINKLIB expat}
   {$endif GDB_USES_EXPAT_LIB}
@@ -267,7 +334,9 @@ interface
   {$LINKLIB iberty}
   {$LINKLIB ncurses}
   { $ LINKLIB m} // include in libroot under BeOS
-  {$LINKLIB intl}
+  {$ifndef GDB_DISABLE_INTL}
+    {$LINKLIB intl}
+  {$endif ndef GDB_DISABLE_INTL}
   {$ifdef GDB_USES_EXPAT_LIB}
     {$LINKLIB expat}
   {$endif GDB_USES_EXPAT_LIB}
@@ -277,6 +346,8 @@ interface
   {$LINKLIB gcc}
 {$endif beos}
 
+{$endif NotImplemented}
+
 {$ifdef go32v2}
   {$define supportexceptions}
 {$endif go32v2}
@@ -327,6 +398,9 @@ const
 
 type
 {$if defined(CPUSPARC) and defined(LINUX)}
+  {$define GDB_CORE_ADDR_FORCE_64BITS}
+{$endif}
+{$ifdef GDB_CORE_ADDR_FORCE_64BITS}
   CORE_ADDR = qword;
 {$else}
   CORE_ADDR = ptrint; { might be target dependent PM }
@@ -496,6 +570,8 @@ type
     procedure EndSession(code:longint);
     procedure DebuggerScreen;
     procedure UserScreen;
+    procedure FlushAll; virtual;
+    function Query(question : pchar; args : pchar) : longint; virtual;
     { Hooks }
     procedure DoSelectSourceline(const fn:string;line:longint);virtual;
     procedure DoStartSession;virtual;
@@ -621,7 +697,11 @@ type
        language_fortran,language_m2,language_asm,
        language_scm,language_pascal,language_objc);
 
-     bptype = (bp_breakpoint,bp_hardware_breakpoint,
+     bptype = (
+{$ifdef GDB_HAS_BP_NONE}
+       bp_none,
+{$endif GDB_HAS_BP_NONE}
+       bp_breakpoint,bp_hardware_breakpoint,
        bp_until,bp_finish,bp_watchpoint,bp_hardware_watchpoint,
        bp_read_watchpoint,bp_access_watchpoint,
        bp_longjmp,bp_longjmp_resume,bp_step_resume,
@@ -1155,11 +1235,15 @@ var
 { external variables }
   error_return : jmp_buf;cvar;public;
   quit_return  : jmp_buf;cvar;public;
-  {$ifdef GDB_HAS_DEPRECATED_CBPH}
-  deprecated_create_breakpoint_hook : pointer;cvar;external;
-  {$else}
-  create_breakpoint_hook : pointer;cvar;external;
-  {$endif}
+  deprecated_query_hook : pointer;cvar;public;
+
+  {$ifndef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+    {$ifdef GDB_HAS_DEPRECATED_CBPH}
+    deprecated_create_breakpoint_hook : pointer;cvar;external;
+    {$else}
+    create_breakpoint_hook : pointer;cvar;external;
+    {$endif}
+  {$endif ndef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
   current_target : target_ops;cvar;external;
   stop_pc      : CORE_ADDR;cvar;external;
   { Only used from GDB 5.01 but doesn't hurst otherwise }
@@ -1206,7 +1290,11 @@ procedure gdb_init;cdecl;external;
 {$endif not GDB_INIT_HAS_ARGV0}
 procedure execute_command(p:pchar;i:longint);cdecl;external;
 procedure target_kill;cdecl;external;
+{$ifdef GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
+procedure target_close(pt : ptarget_ops; i:longint);cdecl;external;
+{$else not GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
 procedure target_close(i:longint);cdecl;external;
+{$endif ndef GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
 
 
 {*****************************************************************************
@@ -1548,6 +1636,20 @@ begin
 {$endif}
 end;
 
+procedure annotate_new_thread;cdecl;public;
+begin
+{$ifdef Verbose}
+  Debug('|annotate_new_thread()|');
+{$endif}
+end;
+
+procedure annotate_thread_changed;cdecl;public;
+begin
+{$ifdef Verbose}
+  Debug('|annotate_thread_changed()|');
+{$endif}
+end;
+
 
 procedure annotate_breakpoint(num:longint);cdecl;public;
 begin
@@ -2051,6 +2153,21 @@ begin
 end;
 
 
+function QueryHook(question : pchar; args : array of const) : longint; cdecl;
+begin
+  if not assigned(curr_gdb) then
+    QueryHook:=0
+  else
+    begin
+      if curr_gdb^.reset_command and (pos('Kill',question)>0) then
+        QueryHook:=1
+      else if pos('%s',question)>0 then
+        QueryHook:=curr_gdb^.Query(question, args[0].vpchar)
+      else
+        QueryHook:=curr_gdb^.Query(question, nil);
+    end;
+end;
+
 procedure CreateBreakPointHook(var b:breakpoint);cdecl;
 var
   sym : symtab_and_line;
@@ -2084,6 +2201,37 @@ begin
    end;
 end;
 
+{$ifdef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+
+type
+  breakpoint_created_function_type = procedure (bpnum : longint); cdecl;
+  pobserver = pointer;
+var
+  breakpoint_created_observer : pobserver = nil;
+
+function observer_attach_breakpoint_created(create_func : breakpoint_created_function_type) : pobserver;cdecl;external;
+procedure observer_detach_breakpoint_created(pob : pobserver);cdecl;external;
+
+var breakpoint_chain : pbreakpoint ;cvar;external;
+
+
+procedure notify_breakpoint_created(bpnum : longint);cdecl;
+var
+  pb : pbreakpoint;
+begin
+  pb:=breakpoint_chain;
+  while assigned(pb) do
+    begin
+      if pb^.number=bpnum then
+        begin
+          CreateBreakPointHook(pb^);
+          exit;
+        end
+      else
+        pb:=pb^.next;
+    end;
+end;
+{$endif def GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
 
 {*****************************************************************************
                                  tgdbinterface
@@ -2131,11 +2279,17 @@ procedure tgdbinterface.gdb__init;
 begin
   gdboutputbuf.reset;
   gdberrorbuf.reset;
-  {$ifdef GDB_HAS_DEPRECATED_CBPH}
-  deprecated_create_breakpoint_hook:=@CreateBreakPointHook;
-  {$else}
-  create_breakpoint_hook:=@CreateBreakPointHook;
+  {$ifdef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+    breakpoint_created_observer:=observer_attach_breakpoint_created(@notify_breakpoint_created);
+  {$else not GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+    {$ifdef GDB_HAS_DEPRECATED_CBPH}
+    deprecated_create_breakpoint_hook:=@CreateBreakPointHook;
+    {$else}
+    create_breakpoint_hook:=@CreateBreakPointHook;
+    {$endif}
   {$endif}
+  deprecated_query_hook :=@QueryHook;
+
   signal_string:=nil;
   signal_name:=nil;
 end;
@@ -2146,16 +2300,33 @@ procedure tgdbinterface.gdb_done;
 begin
   if debuggee_started then
     begin
-      current_target.to_kill;
-      current_target.to_close(1);
+      target_kill;
+{$ifdef GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
+      target_close(@current_target,1);
+{$else not GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
+      target_close(1);
+{$endif ndef GDB_TARGET_CLOSE_HAS_PTARGET_ARG}
     end;
-  {$ifdef GDB_HAS_DEPRECATED_CBPH}
-  deprecated_create_breakpoint_hook:=nil;
-  {$else}
-  create_breakpoint_hook:=nil;
+  {$ifdef GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+    observer_detach_breakpoint_created(breakpoint_created_observer);
+    breakpoint_created_observer:=nil;
+  {$else not GDB_HAS_OBSERVER_NOTIFY_BREAKPOINT_CREATED}
+    {$ifdef GDB_HAS_DEPRECATED_CBPH}
+    deprecated_create_breakpoint_hook:=nil;
+    {$else}
+    create_breakpoint_hook:=nil;
+    {$endif}
   {$endif}
 end;
 
+procedure tgdbinterface.FlushAll;
+begin
+end;
+
+function tgdbinterface.Query(question : pchar; args : pchar) : longint;
+begin
+  Query:=0;
+end;
 
 function tgdbinterface.error:boolean;
 begin
@@ -2529,6 +2700,12 @@ var
   c_argc : longint;external name '___crt0_argc';
   c_argv : ppchar;external name '___crt0_argv';
 {$endif def go32v2}
+var
+  current_directory : pchar; cvar; external;
+  gdb_dirbuf : array[0..0] of char; cvar; external;
+  CurrentDir : AnsiString;
+const
+  DIRBUF_SIZE = 1024;
 
 procedure InitLibGDB;
 {$ifdef supportexceptions}
@@ -2574,7 +2751,12 @@ begin
 //  gdb_stdtargin := gdb_stdin;
   gdb_stdtargerr := gdb_stderr;
 {$endif}
-
+  GetDir(0, CurrentDir);
+  if length(CurrentDir)<DIRBUF_SIZE then
+    strpcopy(@gdb_dirbuf,CurrentDir)
+  else
+    gdb_dirbuf[0]:=#0;
+  current_directory:=@gdb_dirbuf[0];
   next_exit:=exitproc;
   exitproc:=@DoneLibGDB;
 {$ifdef GDB_V6}