ia64/xen-unstable

view tools/debugger/pdb/Util.ml @ 6552:a9873d384da4

Merge.
author adsharma@los-vmm.sc.intel.com
date Thu Aug 25 12:24:48 2005 -0700 (2005-08-25)
parents 112d44270733 fa0754a9f64f
children dfaf788ab18c
line source
1 (** Util.ml
2 *
3 * various utility functions
4 *
5 * @author copyright (c) 2005 alex ho
6 * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
7 * @version 1
8 *)
10 let int_of_hexchar h =
11 let i = int_of_char h in
12 match h with
13 | '0' .. '9' -> i - (int_of_char '0')
14 | 'a' .. 'f' -> i - (int_of_char 'a') + 10
15 | 'A' .. 'F' -> i - (int_of_char 'A') + 10
16 | _ -> raise (Invalid_argument "unknown hex character")
18 let hexchar_of_int i =
19 let hexchars = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
20 '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f' |]
21 in
22 hexchars.(i)
25 (** flip the bytes of a four byte int
26 *)
28 let flip_int num =
29 let a = num mod 256
30 and b = (num / 256) mod 256
31 and c = (num / (256 * 256)) mod 256
32 and d = (num / (256 * 256 * 256)) in
33 (a * 256 * 256 * 256) + (b * 256 * 256) + (c * 256) + d
36 let flip_int32 num =
37 let a = Int32.logand num 0xffl
38 and b = Int32.logand (Int32.shift_right_logical num 8) 0xffl
39 and c = Int32.logand (Int32.shift_right_logical num 16) 0xffl
40 and d = (Int32.shift_right_logical num 24) in
41 (Int32.logor
42 (Int32.logor (Int32.shift_left a 24) (Int32.shift_left b 16))
43 (Int32.logor (Int32.shift_left c 8) d))
46 let int_list_of_string_list list =
47 List.map (fun x -> int_of_string x) list
49 let int_list_of_string str len =
50 let array_of_string s =
51 let int_array = Array.make len 0 in
52 for loop = 0 to len - 1 do
53 int_array.(loop) <- (Char.code s.[loop]);
54 done;
55 int_array
56 in
57 Array.to_list (array_of_string str)
60 (* remove leading and trailing whitespace from a string *)
62 let chomp str =
63 let head = Str.regexp "^[ \t\r\n]+" in
64 let tail = Str.regexp "[ \t\r\n]+$" in
65 let str = Str.global_replace head "" str in
66 Str.global_replace tail "" str
68 (* Stupid little parser for "<key>=<value>[,<key>=<value>]*"
69 It first chops the entire command at each ',', so no ',' in key or value!
70 Mucked to return a list of words for "value"
71 *)
73 let list_of_string str =
74 let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
75 let str_list = Str.split (delim " ") str in
76 List.map (fun x -> chomp(x)) str_list
78 let little_parser fn str =
79 let delim c = Str.regexp ("[ \t]*" ^ c ^ "[ \t]*") in
80 let str_list = Str.split (delim ",") str in
81 let pair s =
82 match Str.split (delim "=") s with
83 | [key;value] -> fn (chomp key) (list_of_string value)
84 | [key] -> fn (chomp key) []
85 | _ -> failwith (Printf.sprintf "error: (little_parser) parse error [%s]" str)
86 in
87 List.iter pair str_list
89 (* boolean list membership test *)
90 let not_list_member the_list element =
91 try
92 List.find (fun x -> x = element) the_list;
93 false
94 with
95 Not_found -> true
97 (* a very inefficient way to remove the elements of one list from another *)
98 let list_remove the_list remove_list =
99 List.filter (not_list_member remove_list) the_list
101 (* get a description of a file descriptor *)
102 let get_connection_info fd =
103 let get_local_info fd =
104 let sockname = Unix.getsockname fd in
105 match sockname with
106 | Unix.ADDR_UNIX(s) -> "unix"
107 | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
108 (string_of_int p))
109 and get_remote_info fd =
110 let sockname = Unix.getpeername fd in
111 match sockname with
112 | Unix.ADDR_UNIX(s) -> s
113 | Unix.ADDR_INET(a,p) -> ((Unix.string_of_inet_addr a) ^ ":" ^
114 (string_of_int p))
115 in
116 try
117 get_remote_info fd
118 with
119 | Unix.Unix_error (Unix.ENOTSOCK, s1, s2) ->
120 let s = Unix.fstat fd in
121 Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
122 | Unix.Unix_error (Unix.EBADF, s1, s2) ->
123 let s = Unix.fstat fd in
124 Printf.sprintf "dev: %d, inode: %d" s.Unix.st_dev s.Unix.st_ino
125 | _ -> get_local_info fd
128 (* really write a string *)
129 let really_write fd str =
130 let strlen = String.length str in
131 let sent = ref 0 in
132 while (!sent < strlen) do
133 sent := !sent + (Unix.write fd str !sent (strlen - !sent))
134 done
136 let write_character fd ch =
137 let str = String.create 1 in
138 str.[0] <- ch;
139 really_write fd str
143 let send_reply fd reply =
144 let checksum = ref 0 in
145 write_character fd '$';
146 for loop = 0 to (String.length reply) - 1 do
147 write_character fd reply.[loop];
148 checksum := !checksum + int_of_char reply.[loop]
149 done;
150 write_character fd '#';
151 write_character fd (hexchar_of_int ((!checksum mod 256) / 16));
152 write_character fd (hexchar_of_int ((!checksum mod 256) mod 16))
153 (*
154 * BUG NEED TO LISTEN FOR REPLY +/- AND POSSIBLY RE-TRANSMIT
155 *)
158 (** A few debugger commands such as step 's' and continue 'c' do
159 * not immediately return a response to the debugger. In these
160 * cases we raise No_reply instead.
161 * This is also used by some contexts (such as Linux processes)
162 * which utilize an asynchronous request / response protocol when
163 * communicating with their respective backends.
164 *)
165 exception No_reply