Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tools: add a file of GDB macros useful for debugging the runtime 

debugger: add two low-level commands for debugging in tandem with gdb


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15838 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2015-02-12 21:31:20 +00:00
parent 4c1b09cdc4
commit 85f479822e
4 changed files with 254 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
debugger/command_line.ml
View File

@ -291,6 +291,11 @@ let instr_kill ppf lexbuf =
show_no_point()
end
let instr_pid ppf lexbuf =
eol lexbuf;
if not !loaded then error "The program is not being run.";
fprintf ppf "@[%d@]@." !current_checkpoint.c_pid
let instr_run ppf lexbuf =
eol lexbuf;
ensure_loaded ();
@ -514,6 +519,30 @@ let instr_print ppf lexbuf = print_command !max_printer_depth ppf lexbuf
let instr_display ppf lexbuf = print_command 1 ppf lexbuf
let instr_address ppf lexbuf =
let exprs = expression_list_eol Lexer.lexeme lexbuf in
ensure_loaded ();
let env =
try
env_of_event !selected_event
with
| Envaux.Error msg ->
Envaux.report_error ppf msg;
raise Toplevel
in
let print_addr expr =
let (v, _ty) =
try Eval.expression !selected_event env expr
with Eval.Error msg ->
Eval.report_error ppf msg;
raise Toplevel
in
match Remote_value.pointer v with
| "" -> fprintf ppf "[not a remote value]@."
| s -> fprintf ppf "0x%s@." s
in
List.iter print_addr exprs
(* Loading of command files *)
let extract_filename arg =
@ -987,6 +1016,12 @@ With no argument, reset the search path." };
{ instr_name = "kill"; instr_prio = false;
instr_action = instr_kill; instr_repeat = true; instr_help =
"kill the program being debugged." };
{ instr_name = "pid"; instr_prio = false;
instr_action = instr_pid; instr_repeat = true; instr_help =
"print the process ID of the current active process." };
{ instr_name = "address"; instr_prio = false;
instr_action = instr_address; instr_repeat = true; instr_help =
"print the raw address of a value." };
{ instr_name = "help"; instr_prio = false;
instr_action = instr_help; instr_repeat = true; instr_help =
"print list of commands." };

10
debugger/debugcom.ml
View File

@ -293,4 +293,14 @@ module Remote_value =
(* string equality -> equality of remote pointers *)
| (_, _) -> false
let pointer rv =
match rv with
| Remote v ->
let bytes = ref [] in
String.iter (fun c -> bytes := c :: !bytes) v;
let obytes = if Sys.big_endian then List.rev !bytes else !bytes in
let to_hex c = Printf.sprintf "%02x" (Char.code c) in
String.concat "" (List.map to_hex obytes)
| Local _ -> ""
end

3
debugger/debugcom.mli
View File

@ -105,4 +105,7 @@ module Remote_value :
val accu : unit -> t
val closure_code : t -> int
(* Returns a hexadecimal representation of the remote address,
or [""] if the value is local. *)
val pointer : t -> string
end

206
tools/gdb-macros Normal file
View File

@ -0,0 +1,206 @@
#########################################################################
# #
# OCaml #
# #
# Damien Doligez, Jane Street Capital #
# #
# Copyright 2015 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
# A set of macros for low-level debugging of OCaml programs and of the
# OCaml runtime itself (both native and byte-code).
# This file should be loaded in gdb with [ source gdb-macros ].
# It defines one command: [caml]
# Usage:
# [caml <value>]
# If <value> is an OCaml value, this will display it in a low-level
# but legible format, including the header information.
# To do: a [camlsearch] command to find all (gc-traceable) pointers to
# a given heap block.
set $camlwordsize = sizeof(char *)
if $camlwordsize == 8
set $caml_unalloc_mask = 0xFF00FFFFFF00FFFF
set $caml_unalloc_value = 0xD700D7D7D700D6D7
else
set $caml_unalloc_mask = 0xFF00FFFF
set $caml_unalloc_value = 0xD700D6D7
end
define camlcheckheader
if $arg0 >> 10 <= 0 || $arg0 >> 10 > 0x1000000000000
if ($arg0 & $caml_unalloc_mask) == $caml_unalloc_value
set $camlcheckheader_result = 2
else
set $camlcheckheader_result = 1
end
else
set $camlcheckheader_result = 0
end
end
define camlheader
set $hd = * (unsigned long *) ($arg0 - $camlwordsize)
set $tag = $hd & 0xFF
set $color = ($hd >> 8) & 3
set $size = $hd >> 10
camlcheckheader $hd
if $camlcheckheader_result != 0
if $camlcheckheader_result == 2
printf "[UNALLOCATED MEMORY]"
else
printf "[**invalid header**]"
end
set $size = 0
else
printf "["
if $color == 0
printf "white "
end
if $color == 1
printf "gray "
end
if $color == 2
printf "blue "
end
if $color == 3
printf "black "
end
if $tag < 246
printf "tag%d ", $tag
end
if $tag == 246
printf "Lazy "
end
if $tag == 247
printf "Closure "
end
if $tag == 248
printf "Object "
end
if $tag == 249
printf "Infix "
end
if $tag == 250
printf "Forward "
end
if $tag == 251
printf "Abstract "
end
if $tag == 252
printf "String "
end
if $tag == 253
printf "Double "
end
if $tag == 254
printf "Double_array "
end
if $tag == 255
printf "Custom "
end
printf "%d]", $size
end
end
define camlheap
if $arg0 >= caml_young_start && $arg0 < caml_young_end
printf "YOUNG"
else
set $chunk = caml_heap_start
set $found = 0
while $chunk != 0 && ! $found
set $chunk_size = * (unsigned long *) ($chunk - 2 * $camlwordsize)
if $arg0 >= $chunk && $arg0 < $chunk + $chunk_size
printf "OLD"
set $found = 1
end
set $chunk = * (unsigned long *) ($chunk - $camlwordsize)
end
if ! $found
printf "OUT-OF-HEAP"
end
end
end
define camlint
if ($arg0 & $caml_unalloc_mask) == $caml_unalloc_value
printf "UNALLOCATED MEMORY"
else
printf "INT %ld", ($arg0 >> 1)
end
end
define camlblock
printf "%#lx: ", $arg0
camlheap $arg0
printf " "
camlheader $arg0
set $mysize = $size
printf "\n"
if $tag == 252
x/s $arg0
end
if $tag == 253
x/f $arg0
end
if $tag == 254
while $count < $mysize && $count < 10
if $count + 1 < $size
x/2f $arg0 + $camlwordsize * $count
else
x/f $arg0 + $camlwordsize * $count
end
set $count = $count + 2
end
if $count < $mysize
printf "... truncated ...\n"
end
end
if $tag != 252 && $tag != 253 && $tag != 254
set $isvalues = $tag < 251
set $count = 0
while $count < $mysize && $count < 10
set $adr = $arg0 + $camlwordsize * $count
set $field = * (unsigned long *) $adr
printf "%#lx: [%d] %#016lx ", $adr, $count, $field
if ($field & 7) == 0 && $isvalues
camlheap $field
printf " "
camlheader $field
end
if ($field & 1) == 1
camlint $field
end
printf "\n"
set $count = $count + 1
end
if $count < $mysize
printf "... truncated ...\n"
end
end
end
define caml
if ($arg0 & 1) == 1
camlint $arg0
printf "\n"
end
if ($arg0 & 7) == 0
camlblock $arg0
end
if ($arg0 & 7) != 0 && ($arg0 & 1) != 1
printf "invalid pointer: %#016lx\n", $arg0
end
end