From 4584c2f312bd4a480503e3a15a8f125550533944 Mon Sep 17 00:00:00 2001 From: Damien Doligez Date: Tue, 3 Aug 1999 17:59:18 +0000 Subject: [PATCH] patch de cregut pour les threads + transparent aux .mli git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2389 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- tools/ocamlcp.ml | 7 +++- tools/ocamlprof.ml | 91 ++++++++++++++++++++++++++++++---------------- 2 files changed, 64 insertions(+), 34 deletions(-) diff --git a/tools/ocamlcp.ml b/tools/ocamlcp.ml index ee4c26725..11011657e 100644 --- a/tools/ocamlcp.ml +++ b/tools/ocamlcp.ml @@ -29,6 +29,8 @@ let incompatible o = fprintf stderr "ocamlcp: profiling is incompatible with the %s option\n" o; exit 2 +let ismultithreaded = ref "" + module Options = Main_args.Make_options (struct let _a () = make_archive := true; option "-a" () let _c = option "-c" @@ -48,7 +50,7 @@ module Options = Main_args.Make_options (struct let _o s = option_with_arg "-o" s let _output_obj = option "-output-obj" let _pp s = incompatible "-pp" - let _thread () = incompatible "-thread" + let _thread () = ismultithreaded := "-thread"; option "-thread" () let _unsafe = option "-unsafe" let _use_prims s = option_with_arg "-use-prims" s let _use_runtime s = option_with_arg "-use-runtime" s @@ -77,7 +79,8 @@ let _ = Arg.parse optlist process_file usage; let status = Sys.command - (Printf.sprintf "ocamlc -pp \"ocamlprof -instrument %s\" %s %s" + (Printf.sprintf "ocamlc -pp \"ocamlprof %s -instrument %s\" %s %s" + !ismultithreaded (String.concat " " (List.rev !profargs)) (if !make_archive then "" else "profiling.cmo") (String.concat " " (List.rev !compargs))) in diff --git a/tools/ocamlprof.ml b/tools/ocamlprof.ml index c66b3af2a..668deddba 100644 --- a/tools/ocamlprof.ml +++ b/tools/ocamlprof.ml @@ -6,7 +6,7 @@ (* Ported to Caml Special Light by John Malecki *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) +(* en Automatique. Distributed only by permission. *) (* *) (***********************************************************************) @@ -20,9 +20,16 @@ open Location open Misc open Parsetree +(* User programs must not use identifiers that start with this prefix. *) +let idprefix = "__ocaml_prof";; + + (* Errors specific to the profiler *) exception Profiler of string +(* For use with the thread package *) +let multithreaded = ref false + (* Modes *) let instr_fun = ref false and instr_match = ref false @@ -73,9 +80,16 @@ let insert_action = ref (function x -> () : int -> unit) (* Producing instrumented code *) let add_incr_counter mod_name prof_counter = + if !multithreaded then begin + fprintf !outchan "Mutex.lock %s_lck_%s_;" idprefix mod_name + end; fprintf !outchan - "profile_%s_.(%d) <- Pervasives.succ profile_%s_.(%d); " - mod_name prof_counter mod_name prof_counter + "%s_cnt_%s_.(%d) <- Pervasives.succ %s_cnt_%s_.(%d); " + idprefix mod_name prof_counter idprefix mod_name prof_counter; + if !multithreaded then begin + fprintf !outchan "Mutex.unlock %s_lck_%s_;" idprefix mod_name + end + let counters = ref (Array.create 0 0) @@ -118,11 +132,15 @@ let init_rewrite modes mod_name = cur_point := 0; profile_counter := 0; if !instr_mode then begin - fprintf !outchan "let profile_%s_ = Array.create 000000" mod_name; + if !multithreaded then begin + fprintf !outchan "let %s_lck_%s_ = Mutex.create ();;" idprefix mod_name + end; + fprintf !outchan "let %s_cnt_%s_ = Array.create 000000" idprefix mod_name; pos_len := pos_out !outchan; fprintf !outchan - " 0;; Profiling.counters := (\"%s\", (\"%s\", profile_%s_)) :: !Profiling.counters;; " - mod_name modes mod_name + " 0;; Profiling.counters := \ + (\"%s\", (\"%s\", %s_cnt_%s_)) :: !Profiling.counters;; " + mod_name modes idprefix mod_name end let final_rewrite () = @@ -336,6 +354,13 @@ let rewrite_file srcfile = final_rewrite(); close_in !inchan +(* Copy a non-.ml file without change *) +let null_rewrite srcfile = + inchan := open_in_bin srcfile; + copy (in_channel_length !inchan); + close_in !inchan +;; + (* Setting flags from saved config *) let set_flags s = for i = 0 to String.length s - 1 do @@ -360,32 +385,33 @@ let dumpfile = ref "ocamlprof.dump" let process_file filename = if not (Filename.check_suffix filename ".ml") then - raise(Profiler(filename ^ " is not a .ml file")); - let modname = Filename.basename(Filename.chop_suffix filename ".ml") in - if !instr_mode then begin - (* Instrumentation mode *) - insert_action := add_incr_counter modname; - set_flags !modes; - init_rewrite !modes modname; - rewrite_file filename - end else begin - (* Results mode *) - insert_action := add_val_counter; - let ic = open_in_bin !dumpfile in - let allcounters = - (input_value ic : (string * (string * int array)) list) in - close_in ic; - let (modes, cv) = - try - List.assoc modname allcounters - with Not_found -> - raise(Profiler("Module " ^ modname ^ " not used in this profile.")) - in - counters := cv; - set_flags modes; - init_rewrite modes modname; - rewrite_file filename - end + null_rewrite filename + else + let modname = Filename.basename(Filename.chop_suffix filename ".ml") in + if !instr_mode then begin + (* Instrumentation mode *) + insert_action := add_incr_counter modname; + set_flags !modes; + init_rewrite !modes modname; + rewrite_file filename + end else begin + (* Results mode *) + insert_action := add_val_counter; + let ic = open_in_bin !dumpfile in + let allcounters = + (input_value ic : (string * (string * int array)) list) in + close_in ic; + let (modes, cv) = + try + List.assoc modname allcounters + with Not_found -> + raise(Profiler("Module " ^ modname ^ " not used in this profile.")) + in + counters := cv; + set_flags modes; + init_rewrite modes modname; + rewrite_file filename + end (* Main function *) @@ -400,6 +426,7 @@ let main () = " Use as dump file (default ocamlprof.dump)"; "-F", Arg.String (fun s -> special_id := s), " Insert string with the counts"; + "-thread", Arg.Set multithreaded, " (undocumented)"; "-instrument", Arg.Set instr_mode, " (undocumented)"; "-m", Arg.String (fun s -> modes := s), " (undocumented)" ] process_file usage;