package mopsa

  1. Overview
  2. Docs
package mopsa
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file count_transitions.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
(****************************************************************************)
(*                                                                          *)
(* This file is part of MOPSA, a Modular Open Platform for Static Analysis. *)
(*                                                                          *)
(* Copyright (C) 2017-2022 The MOPSA Project.                               *)
(*                                                                          *)
(* This program is free software: you can redistribute it and/or modify     *)
(* it under the terms of the GNU Lesser General Public License as published *)
(* by the Free Software Foundation, either version 3 of the License, or     *)
(* (at your option) any later version.                                      *)
(*                                                                          *)
(* This program is distributed in the hope that it will be useful,          *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of           *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            *)
(* GNU Lesser General Public License for more details.                      *)
(*                                                                          *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this program.  If not, see <http://www.gnu.org/licenses/>.    *)
(*                                                                          *)
(****************************************************************************)

open Mopsa
open Format

module Hook =
struct

  let name = "cpy.count_transitions"

  type entry = {
      mutable py2c: int;
      mutable c2py: int;
    }

  let table : (Callstack.callstack, entry) Hashtbl.t = Hashtbl.create 1

  let cut_callstack cs = if cs = [] then [] else [List.hd @@ List.rev cs]

  let incr_py2c cs =
    let cs = cut_callstack cs in
    let oc = Hashtbl.find_opt table cs in
    match oc with
    | None -> Hashtbl.add table cs {py2c = 1; c2py = 0}
    | Some c -> c.py2c <- c.py2c + 1

  let incr_c2py cs =
    let cs = cut_callstack cs in
    let oc = Hashtbl.find_opt table cs in
    match oc with
    | None -> Hashtbl.add table cs {py2c = 0; c2py = 1}
    | Some c -> c.c2py <- c.c2py + 1

  let init ctx = ()

  let is_cur_bottom man flow =
    man.lattice.is_bottom (Flow.get T_cur man.lattice flow)

  let on_before_eval route semantic exp man flow =
    if is_cur_bottom man flow then () else
    match ekind exp with
    | Python.Ast.E_py_call ({ekind = Python.Ast.E_py_object ({addr_kind = Python.Addr.A_py_c_function(name, uid, kind, oflags, self)}, _)}, args, kwargs) ->
       incr_py2c (Flow.get_callstack flow)
    | C.Ast.E_c_builtin_call ("PyObject_CallFunction", _)
    | C.Ast.E_c_builtin_call ("PyObject_CallMethod", _)
    | C.Ast.E_c_builtin_call ("PyObject_CallObject", _) ->
       incr_c2py (Flow.get_callstack flow)
    | _ -> ()

  let on_after_eval route semantic exp man flow evl = ()

  let on_before_exec route stmt man flow = ()

  let on_after_exec route stmt man flow post = ()

  let on_finish man flow =
    let mi, count, ma = Hashtbl.fold (fun cs entry (mi, count, ma) ->
        let py2c, c2py = entry.py2c, entry.c2py in
        (* Format.eprintf "%a: %d, %d@." Callstack.pp_callstack_short cs py2c c2py; *)
        (min mi py2c+c2py, count + py2c + c2py, max ma py2c+c2py)) table (1000000000, 0, -1000000000) in
    Format.eprintf "min, average, max number of crossings: %d %f %d@." mi (float_of_int count /. (float_of_int @@ Hashtbl.length table)) ma
end

let () =
  Core.Hook.register_stateless_hook (module Hook)
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct