1996-03-05 01:57:50 -08:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
1996-04-30 07:53:58 -07:00
|
|
|
(* Objective Caml *)
|
1996-03-05 01:57:50 -08:00
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
1998-04-06 09:34:56 -07:00
|
|
|
(* Copyright 1998 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1996-03-05 01:57:50 -08:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
1998-04-06 09:34:56 -07:00
|
|
|
open Printf
|
|
|
|
|
1996-05-11 11:26:49 -07:00
|
|
|
let compargs = ref ([] : string list)
|
1996-03-05 01:57:50 -08:00
|
|
|
let profargs = ref ([] : string list)
|
|
|
|
let toremove = ref ([] : string list)
|
|
|
|
|
1996-05-11 11:26:49 -07:00
|
|
|
let option opt () = compargs := opt :: !compargs
|
|
|
|
let option_with_arg opt arg = compargs := arg :: opt :: !compargs
|
|
|
|
let process_file filename = compargs := filename :: !compargs
|
1996-03-05 01:57:50 -08:00
|
|
|
|
1998-04-06 09:34:56 -07:00
|
|
|
let make_archive = ref false
|
|
|
|
|
1996-10-24 07:17:48 -07:00
|
|
|
let usage = "Usage: ocamlcp <options> <files>\noptions are:"
|
|
|
|
|
1998-04-06 09:34:56 -07:00
|
|
|
let incompatible o =
|
|
|
|
fprintf stderr "ocamlcp: profiling is incompatible with the %s option\n" o;
|
|
|
|
exit 2
|
1996-10-24 07:17:48 -07:00
|
|
|
|
1999-08-03 10:59:18 -07:00
|
|
|
let ismultithreaded = ref ""
|
|
|
|
|
1998-04-06 09:34:56 -07:00
|
|
|
module Options = Main_args.Make_options (struct
|
|
|
|
let _a () = make_archive := true; option "-a" ()
|
|
|
|
let _c = option "-c"
|
1998-11-06 07:39:43 -08:00
|
|
|
let _cc s = option_with_arg "-cc" s
|
1998-04-06 09:34:56 -07:00
|
|
|
let _cclib s = option_with_arg "-cclib" s
|
|
|
|
let _ccopt s = option_with_arg "-ccopt" s
|
|
|
|
let _custom = option "-custom"
|
2001-10-30 01:32:32 -08:00
|
|
|
let _dllib = option_with_arg "-dllib"
|
2001-08-28 07:47:48 -07:00
|
|
|
let _dllpath = option_with_arg "-dllpath"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _g = option "-g"
|
|
|
|
let _i = option "-i"
|
|
|
|
let _I s = option_with_arg "-I" s
|
|
|
|
let _impl s = option_with_arg "-impl" s
|
|
|
|
let _intf s = option_with_arg "-intf" s
|
1998-11-04 02:56:20 -08:00
|
|
|
let _intf_suffix s = option_with_arg "-intf-suffix" s
|
2000-03-24 11:31:25 -08:00
|
|
|
let _labels = option "-labels"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _linkall = option "-linkall"
|
1998-11-04 02:56:20 -08:00
|
|
|
let _make_runtime = option "-make-runtime"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _noassert = option "-noassert"
|
2001-09-06 01:52:32 -07:00
|
|
|
let _nolabels = option "-nolabels"
|
2000-03-09 01:12:28 -08:00
|
|
|
let _noautolink = option "-noautolink"
|
2002-02-14 07:17:11 -08:00
|
|
|
let _nostdlib = option "-nostdlib"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _o s = option_with_arg "-o" s
|
|
|
|
let _output_obj = option "-output-obj"
|
2002-02-08 08:55:44 -08:00
|
|
|
let _pack = option "-pack"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _pp s = incompatible "-pp"
|
2002-04-18 00:27:47 -07:00
|
|
|
let _principal = option "-principal"
|
1999-11-09 01:14:54 -08:00
|
|
|
let _rectypes = option "-rectypes"
|
1999-08-03 10:59:18 -07:00
|
|
|
let _thread () = ismultithreaded := "-thread"; option "-thread" ()
|
1998-04-06 09:34:56 -07:00
|
|
|
let _unsafe = option "-unsafe"
|
1998-11-04 02:56:20 -08:00
|
|
|
let _use_prims s = option_with_arg "-use-prims" s
|
|
|
|
let _use_runtime s = option_with_arg "-use-runtime" s
|
1998-04-06 09:34:56 -07:00
|
|
|
let _v = option "-v"
|
|
|
|
let _verbose = option "-verbose"
|
1998-11-05 00:04:40 -08:00
|
|
|
let _w = option_with_arg "-w"
|
2000-08-23 10:13:17 -07:00
|
|
|
let _warn_error = option_with_arg "-warn-error"
|
2000-11-07 06:41:12 -08:00
|
|
|
let _where = option "-where"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _nopervasives = option "-nopervasives"
|
1999-09-08 10:42:52 -07:00
|
|
|
let _dparsetree = option "-dparsetree"
|
1998-04-06 09:34:56 -07:00
|
|
|
let _drawlambda = option "-drawlambda"
|
|
|
|
let _dlambda = option "-dlambda"
|
|
|
|
let _dinstr = option "-dinstr"
|
|
|
|
let anonymous = process_file
|
|
|
|
end)
|
1996-10-24 07:17:48 -07:00
|
|
|
|
1998-04-06 09:34:56 -07:00
|
|
|
let _ =
|
|
|
|
let optlist = Options.list @ [
|
1996-10-29 06:52:15 -08:00
|
|
|
"-p", Arg.String(fun s -> profargs := s :: "-m" :: !profargs),
|
1996-10-24 07:17:48 -07:00
|
|
|
"[afilmt] Profile constructs specified by argument:\n\
|
1998-08-07 11:45:17 -07:00
|
|
|
\032 a Everything\n\
|
1999-09-14 10:20:03 -07:00
|
|
|
\032 f Function calls and method calls\n\
|
1998-08-07 11:45:17 -07:00
|
|
|
\032 i if ... then ... else\n\
|
|
|
|
\032 l while, for\n\
|
|
|
|
\032 m match ... with\n\
|
|
|
|
\032 t try ... with"
|
1998-04-06 09:34:56 -07:00
|
|
|
]
|
|
|
|
in
|
|
|
|
Arg.parse optlist process_file usage;
|
1996-03-05 01:57:50 -08:00
|
|
|
let status =
|
1996-05-11 11:26:49 -07:00
|
|
|
Sys.command
|
1999-08-03 10:59:18 -07:00
|
|
|
(Printf.sprintf "ocamlc -pp \"ocamlprof %s -instrument %s\" %s %s"
|
1999-11-29 11:04:56 -08:00
|
|
|
!ismultithreaded
|
1996-06-11 09:01:43 -07:00
|
|
|
(String.concat " " (List.rev !profargs))
|
1998-05-23 07:12:38 -07:00
|
|
|
(if !make_archive then "" else "profiling.cmo")
|
1996-06-11 09:01:43 -07:00
|
|
|
(String.concat " " (List.rev !compargs))) in
|
1996-03-05 01:57:50 -08:00
|
|
|
exit status
|