Date: Thu, 22 Apr 1999 01:00:45 +0100
Message-Id: <199904220000.BAA03017@toy.william.bogus>
From: William Chesters <williamc@dai.ed.ac.uk>
To: caml-list@inria.fr
Subject: patch: ocamldebug prints float arrays without barfing
Here's a patch to allow ocamldebug to display the value of float array
variables in the debuggee---currently it terminates with an
uncaught [Debugcom.Marshalling_error].
diff -r -C 2 ocaml-2.02/byterun/debugger.c ocaml-2.02-w3/byterun/debugger.c
*** ocaml-2.02/byterun/debugger.c Thu Apr 22 00:54:07 1999
--- ocaml-2.02-w3/byterun/debugger.c Thu Apr 22 00:47:43 1999
***************
*** 303,307 ****
val = getval(dbg_in);
i = getword(dbg_in);
! putval(dbg_out, Field(val, i));
flush(dbg_out);
break;
--- 303,315 ----
val = getval(dbg_in);
i = getword(dbg_in);
! if (Tag_val(val) == Double_array_tag) {
! double d = Double_field(val, i);
! putch(dbg_out, 1);
! really_putblock(dbg_out, (char *)&d, sizeof(double));
! }
! else {
! putch(dbg_out, 0);
! putval(dbg_out, Field(val, i));
! }
flush(dbg_out);
break;
diff -r -C 2 ocaml-2.02/debugger/debugcom.ml ocaml-2.02-w3/debugger/debugcom.ml
*** ocaml-2.02/debugger/debugcom.ml Thu Apr 22 00:54:30 1999
--- ocaml-2.02-w3/debugger/debugcom.ml Thu Apr 22 00:46:56 1999
***************
*** 168,210 ****
module Remote_value =
struct
! type t = string
! let obj v =
! output_char !conn.io_out 'M';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! try
! input_value !conn.io_in
! with End_of_file | Failure _ ->
! raise Marshalling_error
!
! let is_block v =
! Obj.is_block (Array.unsafe_get (Obj.magic v : Obj.t array) 0)
!
! let tag v =
! output_char !conn.io_out 'H';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! let header = input_binary_int !conn.io_in in
! header land 0xFF
!
! let size v =
! output_char !conn.io_out 'H';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! let header = input_binary_int !conn.io_in in
! header lsr 10
let field v n =
! output_char !conn.io_out 'F';
! output_remote_value !conn.io_out v;
! output_binary_int !conn.io_out n;
! flush !conn.io_out;
! input_remote_value !conn.io_in
let of_int n =
let v = String.create value_size in
Array.unsafe_set (Obj.magic v : int array) 0 n;
! v
let local pos =
--- 168,231 ----
module Remote_value =
struct
! type t = UnboxedFloat of float | NormalValue of string
! let obj = function
! | UnboxedFloat d -> Obj.magic d
! | NormalValue v ->
! output_char !conn.io_out 'M';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! try
! input_value !conn.io_in
! with End_of_file | Failure _ ->
! raise Marshalling_error
!
! let is_block = function
! | UnboxedFloat _ -> false
! | NormalValue v ->
! Obj.is_block (Array.unsafe_get (Obj.magic v : Obj.t array) 0)
!
! let tag = function
! | UnboxedFloat _ -> 253
! | NormalValue v ->
! output_char !conn.io_out 'H';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! let header = input_binary_int !conn.io_in in
! header land 0xFF
!
! let size = function
! | UnboxedFloat _ -> raise (Failure "Debugcom.Remote_value.size")
! | NormalValue v ->
! output_char !conn.io_out 'H';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! let header = input_binary_int !conn.io_in in
! header lsr
! (if header land 255 = 254 && value_size = 4 then 11 else 10)
let field v n =
! match v with
! | UnboxedFloat _ -> raise (Failure "Debugcom.Remote_value.field")
! | NormalValue v ->
! output_char !conn.io_out 'F';
! output_remote_value !conn.io_out v;
! output_binary_int !conn.io_out n;
! flush !conn.io_out;
! if input_byte !conn.io_in = 0 then
! NormalValue (input_remote_value !conn.io_in)
! else
! try
! let buf = String.create 8 in
! really_input !conn.io_in buf 0 8;
! UnboxedFloat (Array.unsafe_get (Obj.magic buf) 0)
! with
! End_of_file | Failure _ ->
! raise Marshalling_error
let of_int n =
let v = String.create value_size in
Array.unsafe_set (Obj.magic v : int array) 0 n;
! NormalValue v
let local pos =
***************
*** 212,216 ****
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! input_remote_value !conn.io_in
let from_environment pos =
--- 233,237 ----
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! NormalValue (input_remote_value !conn.io_in)
let from_environment pos =
***************
*** 218,222 ****
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! input_remote_value !conn.io_in
let global pos =
--- 239,243 ----
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! NormalValue (input_remote_value !conn.io_in)
let global pos =
***************
*** 224,239 ****
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! input_remote_value !conn.io_in
let accu () =
output_char !conn.io_out 'A';
flush !conn.io_out;
! input_remote_value !conn.io_in
! let closure_code v =
! output_char !conn.io_out 'C';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! input_binary_int !conn.io_in
end
--- 245,262 ----
output_binary_int !conn.io_out pos;
flush !conn.io_out;
! NormalValue (input_remote_value !conn.io_in)
let accu () =
output_char !conn.io_out 'A';
flush !conn.io_out;
! NormalValue (input_remote_value !conn.io_in)
! let closure_code = function
! | UnboxedFloat _ -> raise (Failure "Debugcom.Remote_value.closure_code")
! | NormalValue v ->
! output_char !conn.io_out 'C';
! output_remote_value !conn.io_out v;
! flush !conn.io_out;
! input_binary_int !conn.io_in
end
This archive was generated by hypermail 2b29 : Sun Jan 02 2000 - 11:58:22 MET