/[mldonkey]/mldonkey/src/utils/cdk/heap.ml
ViewVC logotype

Diff of /mldonkey/src/utils/cdk/heap.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by mldonkey, Thu Jul 29 10:25:34 2004 UTC revision 1.3 by spiralvoice, Wed Jun 1 22:19:57 2005 UTC
# Line 1  Line 1 
1  external dump_heap_c: unit -> unit = "heap_dump"  external dump_heap_c: unit -> unit = "heap_dump"
2  external set_tag : 'a -> int -> unit = "heap_set_tag"  external set_tag : 'a -> int -> unit = "heap_set_tag"
3    
4      (* open CommonGlobals *)
5    (* open CommonTypes *)
6    
7  let memstat_functions = ref []  let memstat_functions = ref []
8      
9  let add_memstat m f = memstat_functions := (m,f) :: !memstat_functions  let add_memstat m f = memstat_functions := (m,f) :: !memstat_functions
10    
11  let print_memstats (level : int) buf =    let print_memstats (level : int) buf output_type =
12    let level = if level < 0 then begin    let level = if level < 0 then begin
13          Gc.compact (); -level          Gc.compact (); -level
14        end else level in        end else level in
15      
16      if output_type = true then
17        begin
18          Printf.bprintf buf "\\<div class=results\\>";
19    (*
20          html_mods_table_header buf "memstatsTable" "memstats" [];
21          html_mods_td buf [
22            ("", "srh", "Memory Debug Stats"); ];
23    *)
24          Printf.bprintf buf "\\<div class=\\\"results\\\"\\>
25    \\<table id=\\\"memstatsTable\\\" name=\\\"memstatsTable\\\" class=\\\"results\\\" cellspacing=0 cellpadding=0\\>
26    \\<tr\\>\\<td class=\\\"srh\\\" \\>Memory Debug Stats\\</td\\>";
27          Printf.bprintf buf "\\</tr\\>\\</table\\>\\</div\\>\n"
28        end
29      else
30    Printf.bprintf buf "Memory Debug Stats:\n";    Printf.bprintf buf "Memory Debug Stats:\n";
31    let list = List.rev !memstat_functions in    let memstat_list = List.rev !memstat_functions in
32    List.iter (fun (m,f) ->    if output_type = true then
33        Printf.bprintf buf "\n----------------------------------\n";      begin
34        Printf.bprintf buf "  Module %s:\n" m ;              let split_string c str =
35        Printf.bprintf buf "----------------------------------\n";          let rec aux s acc =
36        f level buf) list;            try  let ind=String.index s c in
37                       aux (String.sub s (ind+1) ((String.length s) - ind -1 ))
38    dump_heap_c ()                       ((String.sub s 0 ind)::acc)
39                with Not_found -> List.rev (s::acc)
40              in aux str []; in
41          let split_lines = split_string '\n' in
42    
43          List.iter (fun (m,f) ->
44    (*
45              html_mods_table_header buf "memstatsTable" "memstats" [
46                ( "0", "srh", "Module", m ); ];
47    *)
48              Printf.bprintf buf "\\<div class=\\\"results\\\"\n\\>\\<table id=\\\"memstatsTable\\\" name=\\\"memstatsTable\\\" class=\\\"results\\\" cellspacing=0 cellpadding=0
49    \\>\\<tr\\>\\<td class=\\\"srh\\\" \\>Module %s\\</td\\>\\</tr\\>" m;
50              let buftmp = Buffer.create 100 in
51              f level buftmp;
52              let listtmp = split_lines (Buffer.contents buftmp) in
53              (List.iter (fun s ->
54    (*
55                  html_mods_td buf [
56                    ("", "srh", s); ];
57    *)
58                  Printf.bprintf buf "\\<tr class=\\\"dl-1\\\"\\>\\<td class=\\\"sr\\\"\\>";
59                  Printf.bprintf buf "%s" s;
60                  Printf.bprintf buf "\\</td\\>\\</tr\\>";
61                  ) listtmp);
62    
63              Printf.bprintf buf "\\</table\\>\\</div\\>\n";
64              ) memstat_list;
65    
66          Printf.bprintf buf "\\</div\\>\n";
67          dump_heap_c ()
68        end
69      else
70        begin
71          List.iter (fun (m,f) ->
72              Printf.bprintf buf "\n----------------------------------\n";
73              Printf.bprintf buf "  Module %s:\n" m ;      
74              Printf.bprintf buf "----------------------------------\n";
75              f level buf) memstat_list;
76    
77          dump_heap_c ()
78        end;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26