82 lines
2.9 KiB
OCaml
82 lines
2.9 KiB
OCaml
(* $OpenBSD: kerneltrace.ml,v 1.2 2006/05/28 15:44:14 avsm Exp $ *)
|
|
(*
|
|
* Copyright (c) 2004 Anil Madhavapeddy <anil@recoil.org>
|
|
*
|
|
* Permission to use, copy, modify, and distribute this software for any
|
|
* purpose with or without fee is hereby granted, provided that the above
|
|
* copyright notice and this permission notice appear in all copies.
|
|
*
|
|
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
*
|
|
* $Id: kerneltrace.ml,v 1.2 2006/05/28 15:44:14 avsm Exp $
|
|
*)
|
|
|
|
(* introduce log messages to trace kernel messages *)
|
|
|
|
open Pretty
|
|
open Cil
|
|
module E = Errormsg
|
|
|
|
let traceRegexp = ref None
|
|
let traceLogLevel = ref 0
|
|
|
|
class callTraceVisitor f outp = object
|
|
inherit nopCilVisitor
|
|
|
|
method vfunc fundec =
|
|
let funname = fundec.svar.vname in
|
|
match !traceRegexp with
|
|
|None -> SkipChildren
|
|
|Some reg ->
|
|
if Str.string_match (Str.regexp reg) funname 0 then begin
|
|
let args = List.fold_left (fun a b ->
|
|
match b.vtype with
|
|
|TInt (kind, _) ->
|
|
let fmt = match kind with
|
|
|IChar |ISChar |IUChar -> "%c"
|
|
|IInt |IShort |IUShort -> "%d"
|
|
|IUInt -> "%u" |ILong -> "%ld"
|
|
|ILongLong -> "%lld" |IULong -> "%llu"
|
|
|IULongLong -> "%llu" in
|
|
(Printf.sprintf "%s=%s" b.vname fmt, b) :: a
|
|
|_ -> a
|
|
) [] fundec.sformals in
|
|
let args = List.rev args in
|
|
let level = integer (!traceLogLevel) in (* LOG_DEBUG *)
|
|
let formargs = String.concat " " (List.map (fun (a,_) -> a) args) in
|
|
let form = mkString (Printf.sprintf "%s: %s\n" funname formargs) in
|
|
let sargs = List.map (fun (_,b) -> Lval(var b)) args in
|
|
let funvar = level :: form :: sargs in
|
|
let st = mkStmt (Instr[Call(None,outp,funvar,locUnknown)]) in
|
|
fundec.sbody.bstmts <- st :: fundec.sbody.bstmts;
|
|
ChangeTo(fundec)
|
|
end else
|
|
DoChildren
|
|
|
|
end
|
|
|
|
let calltrace f =
|
|
let expify fundec = Lval(Var(fundec.svar), NoOffset) in
|
|
let outp = expify (emptyFunction "log") in
|
|
visitCilFileSameGlobals (new callTraceVisitor f outp) f
|
|
|
|
let feature : featureDescr =
|
|
{ fd_name = "kerneltrace";
|
|
fd_enabled = ref false;
|
|
fd_description = "add log messages to kernel function calls";
|
|
fd_extraopt = [
|
|
("--trace-regexp", Arg.String (fun x -> traceRegexp := Some x),
|
|
"<str> regexp for which functions to insert logging calls");
|
|
("--trace-level", Arg.Int (fun x -> traceLogLevel := x),
|
|
"<int> log level to use for trace messages");
|
|
];
|
|
fd_doit = (function (f: file) -> calltrace f);
|
|
fd_post_check = true;
|
|
}
|