~cypheon/kicad2spice

ref: 96e390bc4f914314da98ecdfd7bd775e620563e2 kicad2spice/lib/connectiongraph.ml -rw-r--r-- 6.3 KiB
96e390bc — Johann Rudloff Implement correct pin order according to field "Spice_Node_Sequence" 3 years ago
                                                                                
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
open List

open Schematic

let reduce f = function
  | x::xs -> List.fold_left f x xs
  | [] -> raise (Invalid_argument "reduce called on empty list")

let min_by compare a b = if (compare a b) < 0
  then a
  else b

module Subgraph = struct
  type t = {
    mutable items : Item.t list;
  }
  [@@deriving show]

  let create () = {
    items = [];
  }

  let add g item = let _ = g.items <- (item::g.items) in ()
end

module Netlist = struct
  type t = {
    nets : (string, Subgraph.t) Hashtbl.t;
    point_net_map : (point2i, string) Hashtbl.t;
    mutable next_netid : int;
  }

  let show n =
    Hashtbl.to_seq n.point_net_map
    |> Seq.map (fun (pt, net) -> Printf.sprintf "Net \"%s\" @ (%s):\n%s" net (show_point2i pt) (Subgraph.show (Hashtbl.find n.nets net)))
    |> of_seq
    |> String.concat "\n===\n"

  let create () = {
    nets = Hashtbl.create 128;
    point_net_map = Hashtbl.create 128;
    next_netid = 1;
  }

  let get_net n pt = match Hashtbl.find_opt n.point_net_map pt with
  | Some net_name -> Hashtbl.find n.nets net_name
  | None ->
      let new_net_name = Printf.sprintf "N_%d" n.next_netid in
      let _ = n.next_netid <- (n.next_netid + 1) in
      let new_subgraph = Subgraph.create () in
      Hashtbl.add n.point_net_map pt new_net_name;
      Hashtbl.add n.nets new_net_name new_subgraph;
      new_subgraph

  module Priority = struct
    type t =
      | None
      | Pin
      | SheetPin
      | HierLabel
      | LocalLabel
      | PowerPin
      | Global
    [@@deriving show, compare]
  end

  let driver_priority = function
    | Item.Pin (comp, _pin) when comp.part.power -> Priority.PowerPin
    | Item.Pin _ -> Priority.Pin
    | _ -> failwith "invalid driver"

  let driver_name = function
    | Item.Pin (comp, pin) when comp.part.power -> pin.name
    | Item.Pin (comp, pin) ->
        if pin.name <> "~"
        then "Net_" ^ comp.ref ^ "_pad_" ^ pin.name
        else comp.ref ^ "_" ^ pin.number
    | _ -> failwith "invalid driver"

  let drivers nl net_name =
    let helper item = (driver_priority item, driver_name item) in
    let items = (Hashtbl.find nl.nets net_name).Subgraph.items
    in map helper items

  let driver_compare (pa, na) (pb, nb) = match Priority.compare pa pb with
    | 0 -> compare na nb
    | x -> -x

  let driver_net_name nl net_name =
    let net_drivers = drivers nl net_name in
    snd @@ reduce (min_by driver_compare) net_drivers

end

let transform_pin {Comp.pos; transform; _} pin = let open Geometry_ops in
  {pin with Pin.pos = pos + transform * pin.Pin.pos}

let get_pins comp =
  map (transform_pin comp) comp.part.pins

let rec get_minpoint (netmap: (point2i, point2i) Hashtbl.t) (pt : point2i) =
  match Hashtbl.find_opt netmap pt with
  | Some minpoint -> (
    if minpoint = pt then (Printf.printf "TRACE minpoint: %s == %s\n" (show_point2i pt) (show_point2i minpoint); pt)
      else (Printf.printf "TRACE minpoint: %s -> %s\n" (show_point2i pt) (show_point2i minpoint);assert ((Stdlib.compare minpoint pt) = -1); get_minpoint netmap minpoint)
  )
  | None -> pt

let make_netmap schematic : (point2i, point2i) Hashtbl.t =
  let n_comps = 128 in
  let named_nets = Hashtbl.create (n_comps * 2) in
  let minpoint_map = Hashtbl.create (n_comps * 2) in
  iter ( fun item -> match item with
    | Item.Wire ({startp;endp;} as _w) ->
        let old_minpoint_start = get_minpoint minpoint_map startp in
        let old_minpoint_end = get_minpoint minpoint_map endp in
        let minpoint = min startp (min endp (min old_minpoint_end old_minpoint_start)) in
        Hashtbl.replace minpoint_map old_minpoint_start minpoint;
        Hashtbl.replace minpoint_map old_minpoint_end minpoint;
        Hashtbl.replace minpoint_map startp minpoint;
        Hashtbl.replace minpoint_map endp minpoint;
        Printf.printf "processing wire: %s\n" (Wire.show _w);
        Printf.printf "join: (%s) -> (%s) [oldmin_start]\n" (show_point2i old_minpoint_start) (show_point2i minpoint);
        Printf.printf "join: (%s) -> (%s) [oldmin_end]\n" (show_point2i old_minpoint_end) (show_point2i minpoint);
        Printf.printf "join: (%s) -> (%s) [start]\n" (show_point2i startp) (show_point2i minpoint);
        Printf.printf "join: (%s) -> (%s) [end]\n" (show_point2i endp) (show_point2i minpoint)
    | Item.Comp c when c.part.power ->
        assert (length c.part.pins = 1);
        let pin = (nth (get_pins c) 0) in
        let net_point = Stdlib.Option.value (Hashtbl.find_opt named_nets pin.name) ~default:pin.pos in
        let old_minpoint = get_minpoint minpoint_map pin.pos in
        let old_net_minpoint = get_minpoint minpoint_map net_point in
        let new_minpoint = min old_net_minpoint old_minpoint in
        Hashtbl.replace minpoint_map old_minpoint new_minpoint;
        Hashtbl.replace minpoint_map old_net_minpoint new_minpoint;
        Hashtbl.replace minpoint_map net_point new_minpoint;
        Hashtbl.replace minpoint_map pin.pos new_minpoint;
        Hashtbl.replace named_nets pin.name new_minpoint;
        Printf.printf "processing power pin: %s\n" (Comp.show c);
        Printf.printf "join: (%s) -> (%s) [old_minpoint]\n" (show_point2i old_minpoint) (show_point2i new_minpoint);
        Printf.printf "join: (%s) -> (%s) [net_point]\n" (show_point2i net_point) (show_point2i new_minpoint);
        Printf.printf "join: (%s) -> (%s) [pin.pos]\n" (show_point2i pin.pos) (show_point2i new_minpoint);
        Printf.printf "join: (%s) -> (%s) [named_nets]\n" (pin.name) (show_point2i new_minpoint)
    | _ -> ()
    ) schematic.items;
  minpoint_map

let connection schematic =
  let n_comps = 128 in
  let netmap = make_netmap schematic in
  let netlist = Netlist.create () in
  let point_map = Hashtbl.create n_comps in
  iter ( fun item -> match item with
    | Item.Comp c ->
        iter ( fun pin ->
          Printf.printf "connectiongraph processing component pin: %s %s\n" (Comp.show c) (Pin.show pin);
          (* TODO: this is not correct! We need to insert a comp*pin pair *)
          Hashtbl.replace point_map pin.Pin.pos (Item.Comp c);
          let minpoint = get_minpoint netmap pin.Pin.pos in
          let net = Netlist.get_net netlist minpoint in
          Subgraph.add net (Item.Pin (c, pin));
        ) (get_pins c)
    | Item.Wire {startp;endp;} as w ->
        Hashtbl.replace point_map startp w;
        Hashtbl.replace point_map endp w;
    | _ -> ()
    ) schematic.items;
  Printf.printf "%s\n\n" (Netlist.show netlist);
  netlist