Version française
Home     About     Download     Resources     Contact us    
Browse thread
patch: ocamldebug prints float arrays without barfing
[ Home ] [ Index: by date | by threads ]
[ Search: ]

[ Message by date: previous | next ] [ Message in thread: previous | next ] [ Thread: previous | next ]
Date: -- (:)
From: William Chesters <williamc@d...>
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