package hardcaml_event_driven_sim

  1. Overview
  2. Docs

Source file vcd.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
open Core
module Signal = Hardcaml.Signal
module Vcd = Hardcaml.Vcd
module Sim = Event_driven_sim.Simulator

module Make (Logic : Logic.S) = struct
  type t =
    { chan : Out_channel.t
    ; processes : Sim.Process.t list
    ; changes : (Vcd.Var.t, Logic.t) Hashtbl.t
    }
  [@@deriving fields ~getters]

  let signal_name s =
    match Signal.names s with
    | h :: _ -> h
    | [] -> "__" ^ Signal.Uid.to_string (Signal.uid s)
  ;;

  let create chan (signals_to_trace : Logic.t Port.t list) =
    let gen = Vcd.Var.Generator.create () in
    let changes = Hashtbl.create (module Vcd.Var) in
    let vars =
      List.map signals_to_trace ~f:(fun port ->
        let id = Vcd.Var.Generator.next gen in
        let var =
          Vcd.Var.create
            ~name:(signal_name port.base_signal)
            ~id
            ~width:(Signal.width port.base_signal)
            ()
        in
        let process =
          Sim.Process.create
            [ Sim.Signal.id port.signal ]
            (fun () ->
              let data = Sim.Signal.read port.signal in
              Hashtbl.set changes ~key:var ~data)
        in
        process, var)
    in
    let scopes = [ Vcd.Scope.create ~name:"traced" ~vars:(List.map vars ~f:snd) () ] in
    Vcd.write_header chan ~config:Vcd.Config.default ~scopes;
    { chan; processes = List.map vars ~f:fst; changes }
  ;;

  let attach_to_simulator { chan; changes; _ } sim =
    Sim.Debug.at_start_of_time_step sim (fun () -> Hashtbl.clear changes);
    Sim.Debug.at_end_of_time_step sim (fun () ->
      Vcd.write_time chan (Sim.current_time sim);
      Hashtbl.iteri changes ~f:(fun ~key:var ~data ->
        Vcd.Var.write_string chan var (Logic.to_string data)))
  ;;
end