Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- open HardCaml
- (* different register types *)
- module Seq = struct
- open Signal
- open Types
- open Seq
- module type S = sig
- include Interface.S
- val reg : Api.Comb.t t -> Signal.Types.register
- end
- module type T = sig
- include Seq
- val sys : (module S)
- end
- module Full = struct
- type 'a t = {
- clock : 'a[@bits 1];
- reset : 'a[@bits 1];
- clear : 'a[@bits 1];
- }[@@deriving hardcaml]
- let reg r =
- { r_full with
- reg_clock = r.clock;
- reg_reset = r.reset;
- reg_clear = r.clear;
- }
- end
- module Async = struct
- type 'a t = {
- clock : 'a[@bits 1];
- reset : 'a[@bits 1];
- }[@@deriving hardcaml]
- let reg r =
- { r_async with
- reg_clock = r.clock;
- reg_reset = r.reset;
- }
- end
- module Sync = struct
- type 'a t = {
- clock : 'a[@bits 1];
- clear : 'a[@bits 1];
- }[@@deriving hardcaml]
- let reg r =
- { r_sync with
- reg_clock = r.clock;
- reg_clear = r.clear;
- }
- end
- module None = struct
- type 'a t = {
- clock : 'a[@bits 1];
- }[@@deriving hardcaml]
- let reg r =
- { r_none with
- reg_clock = r.clock;
- }
- end
- let make reg r =
- let module Seq = Make_seq(struct let reg_spec = reg r let ram_spec = r_none end) in
- (module Seq : Seq)
- end
- (**********************************************************************)
- module type Inst_type = sig
- val inst_type : [ `flat | `inst | `hier of Circuit.Hierarchy.database ]
- end
- module Make_inst(T : Inst_type)(I : Interface.S)(O : Interface.S) = struct
- module Inst = Interface.Inst(I)(O)
- module Hier = Interface.Hier(I)(O)
- let f name f i =
- match T.inst_type with
- | `flat -> f i
- | `inst -> Inst.make name i
- | `hier(db) -> Hier.make db name f i
- end
- module Make_seq_inst(T : Inst_type)(S : Seq.S)(I : Interface.S)(O : Interface.S) = struct
- module Isys = struct
- type 'a t = {
- sys : 'a S.t;
- i : 'a I.t;
- }[@@deriving hardcaml]
- end
- module Inst = Interface.Inst(Isys)(O)
- module Hier = Interface.Hier(Isys)(O)
- let sys = S.(map (fun (n,b) -> Api.Comb.input n b) t)
- module Seq = (val (Seq.make S.reg sys))
- let f name f i =
- match T.inst_type with
- | `flat -> f i
- | `inst -> Inst.make name { Isys.sys = sys; i }
- | `hier(db) -> Hier.make db name (fun i -> f i.Isys.i) { Isys.sys = sys; i }
- end
- module Inst_type = struct
- module Hier() = struct
- let db = Circuit.Hierarchy.empty ()
- let inst_type = `hier(db)
- end
- module Flat = struct let inst_type = `flat end
- module Inst = struct let inst_type = `inst end
- end
- (**********************************************************************)
- module Fa = struct
- module I = struct
- type 'a t = {
- a : 'a[@bits 1];
- b : 'a[@bits 1];
- cin : 'a[@bits 1]
- }[@@deriving hardcaml]
- end
- module O = struct
- type 'a t = {
- sum : 'a[@bits 1];
- cout : 'a[@bits 1];
- }[@@deriving hardcaml]
- end
- let name = "fulladder"
- open Api.Comb
- let f i =
- let open I in
- let sum = i.a ^: i.b ^: i.cin in
- let cout = (i.a ^: i.b) |: (i.a ^: i.cin) |: (i.b ^: i.cin) in
- { O.sum; cout }
- end
- (* combinatorial carry ripple adder *)
- module Carry_ripple(T : Inst_type) = struct
- module I = struct
- type 'a t = {
- a : 'a[@bits 8];
- b : 'a[@bits 8];
- }[@@deriving hardcaml]
- end
- module O = struct
- type 'a t = {
- c : 'a[@bits 9];
- }[@@deriving hardcaml]
- end
- let name = "carry_ripple_adder"
- module Fa_inst = Make_inst(T)(Fa.I)(Fa.O)
- let f i =
- let open I in
- let open Api.Comb in
- let c, s = List.fold_left2
- (fun (c,s) a b ->
- let o = Fa_inst.f Fa.name Fa.f { Fa.I.a; b; cin=c} in
- o.Fa.O.cout,o.Fa.O.sum::s)
- (gnd,[]) (List.rev (bits i.I.a)) (List.rev (bits i.I.b))
- in
- { O.c = concat (c::s) }
- end
- module Reg = struct
- module I = struct
- type 'a t = {
- d : 'a[@bits 9];
- }[@@deriving hardcaml]
- end
- module O = struct
- type 'a t = {
- q : 'a[@bits 9];
- }[@@deriving hardcaml]
- end
- let name = "sync_reg"
- module Make(Seq : Signal.Seq) = struct
- open Api.Comb
- let f i =
- { O.q = Seq.reg ~e:vdd i.I.d }
- end
- end
- module AdderReg(T : Inst_type) = struct
- module Cra = Carry_ripple(T)
- module Cra_inst = Make_inst(T)(Cra.I)(Cra.O)
- module I = Cra.I
- module O = Reg.O
- module Reg_inst = Make_seq_inst(T)(Seq.Full)(Reg.I)(Reg.O)
- let name = "adder_reg"
- let f i =
- (* construct carry ripple adder *)
- let o = Cra_inst.f Cra.name Cra.f i in
- (* register *)
- let module Reg' = Reg.Make(Reg_inst.Seq) in
- Reg_inst.f Reg.name Reg'.f { Reg.I.d = o.Cra.O.c }
- end
- module H = Inst_type.Hier()
- module A = AdderReg(H)
- module Circ = Interface.Circ(A.I)(A.O)
- module A_inst = Make_seq_inst(H)(Seq.Full)(A.I)(A.O)
- let circ = Circ.make "top" (A_inst.f A.name A.f)
- let rtlh() = Rtl.Hierarchy.write H.db "" (fun _ -> Rtl.Verilog.write print_string) circ
- module F = Inst_type.Flat
- module Aflat = AdderReg(F)
- module Aflat_inst = Make_seq_inst(F)(Seq.Full)(Aflat.I)(Aflat.O)
- module Circ = Interface.Circ(Aflat.I)(Aflat.O)
- let circ = Circ.make "top" (Aflat_inst.f Aflat.name Aflat.f)
- let rtlf() = Rtl.Verilog.write print_string circ
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement