├── .gitignore ├── .merlin ├── .travis-ci.sh ├── .travis.yml ├── CHANGES.md ├── LICENSE.md ├── Makefile ├── README.md ├── archive ├── fixed.ml ├── fixed.mli ├── verilog.ml ├── verilog.mli ├── verilog_ext.ml └── verilog_ext.mli ├── csim ├── jbuild ├── sim.ml └── sim.mli ├── hardcaml-csim.opam ├── hardcaml-js.opam ├── hardcaml-lwttb.opam ├── hardcaml.opam ├── js ├── jbuild ├── wave.ml └── wave.mli ├── lwttb ├── jbuild ├── lwtsim.ml ├── lwtsim.mli ├── tb.ml └── tb.mli ├── notebooks ├── 00-introduction.ipynb ├── 01-design-flow.ipynb ├── 02-combinatorial-logic.ipynb ├── 03-sequential-logic.ipynb ├── 04-simulation.ipynb ├── 05-guarded-processes-and-statemachines.ipynb ├── 06-instantiation.ipynb ├── 30-prefix-networks.ipynb ├── 31-lfsr.ipynb └── 50-chisel.ipynb ├── src ├── api.ml ├── api.mli ├── bits.ml ├── bits.mli ├── circuit.ml ├── circuit.mli ├── comb.ml ├── comb.mli ├── cosim.ml ├── cosim.mli ├── cosim2.ml ├── cosim2.mli ├── cyclesim.ml ├── cyclesim.mli ├── fixed.ml ├── fixed.mli ├── graph.ml ├── graph.mli ├── interface.ml ├── interface.mli ├── jbuild ├── recipe.ml ├── recipe.mli ├── rtl.ml ├── rtl.mli ├── signal.ml ├── signal.mli ├── sim_provider.ml ├── sim_provider.mli ├── structural.ml ├── structural.mli ├── transform.ml ├── transform.mli ├── utils.ml ├── utils.mli ├── vcd.ml ├── vcd.mli ├── xilinx.ml └── xilinx.mli ├── staging ├── README.md ├── cyclesim2.ml ├── cyclesim2.mli ├── eventsim.ml ├── eventsim.mli ├── eventsim2.ml ├── eventsim2.mli ├── float.ml ├── float.mli ├── llvmsim.ml └── llvmsim.mli ├── test ├── cctb.ml ├── gwShowall.tcl ├── intf.ml ├── ops.ml ├── recipes.ml ├── simc.ml ├── test.v ├── test_lwttb.ml ├── test_sim_next.ml ├── test_vpi.ml └── test_vpi_load.ml └── tools ├── base64.ml ├── encode.ml └── style.css /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .*.swp 3 | *~ 4 | *.install 5 | .merlin 6 | -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | SRC src 2 | SRC test 3 | PKG ctypes.foreign 4 | PKG astring 5 | PKG topkg 6 | PKG lwt 7 | PKG lwt.ppx 8 | B _build/src 9 | -------------------------------------------------------------------------------- /.travis-ci.sh: -------------------------------------------------------------------------------- 1 | # Edit this for your own project dependencies 2 | OPAM_DEPENDS="ocamlfind ocamlbuild topkg camlp4 ctypes-foreign" 3 | 4 | # install OCaml + OPAM 5 | case "$OCAML_VERSION,$OPAM_VERSION" in 6 | 3.12.1,1.0.0) ppa=avsm/ocaml312+opam10 ;; 7 | 3.12.1,1.1.0) ppa=avsm/ocaml312+opam11 ;; 8 | 4.00.1,1.0.0) ppa=avsm/ocaml40+opam10 ;; 9 | 4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;; 10 | 4.01.0,1.0.0) ppa=avsm/ocaml41+opam10 ;; 11 | 4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;; 12 | 4.01.0,1.2.0) ppa=avsm/ocaml41+opam12 ;; 13 | 4.02.1,1.2.0) ppa=avsm/ocaml42+opam12 ;; 14 | 4.02.2,1.2.0) ppa=avsm/ocaml42+opam12 ;; 15 | 4.02.3,1.2.0) ppa=avsm/ocaml42+opam12 ;; 16 | *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;; 17 | esac 18 | 19 | echo "yes" | sudo add-apt-repository ppa:$ppa 20 | sudo apt-get update -qq 21 | sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam 22 | export OPAMYES=1 23 | opam init 24 | 25 | eval `opam config env` 26 | opam pin add -n $OPAMPKG -k git . 27 | opam depext -y $DEPPKGS $OPAMPKG 28 | 29 | opam install $DEPPKGS $OPAMPKG 30 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | script: bash -ex .travis-ci.sh 4 | env: 5 | - OCAML_VERSION=4.01.0 OPAM_VERSION=1.2.0 OPAMPKG=hardcaml DEPPKGS="" 6 | - OCAML_VERSION=4.01.0 OPAM_VERSION=1.2.0 OPAMPKG=hardcaml DEPPKGS="lwt camlp4 js_of_ocaml ctypes ctypes-foreign" 7 | - OCAML_VERSION=4.02.3 OPAM_VERSION=1.2.0 OPAMPKG=hardcaml DEPPKGS="" 8 | - OCAML_VERSION=4.02.3 OPAM_VERSION=1.2.0 OPAMPKG=hardcaml DEPPKGS="lwt camlp4 js_of_ocaml ctypes ctypes-foreign" 9 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # v1.2.0 2 | 3 | * Reorganise and merge a bunch of modules (esp _ext_.ml) which were split out 4 | previously due to js\_of\_ocaml but is no longer needed. 5 | * Replace oasis with ocamlbuild and topkg 6 | 7 | # v1.1.1 8 | 9 | * add out_port_next function to simulator - update on out_port reverts to old behaviour 10 | * add dynamic simulation plugin back end registering (for llvmsim) 11 | * fix vpi cosim module search path 12 | 13 | # v1.1.0 14 | 15 | * rework simulation so we get the correct output values (in all cases) after cycle 16 | * various simulation hook points added to correctly support waveforms/combining etc 17 | * add `Recipe` module - generates statemchines from imperative style descriptions 18 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, MicroJamJar Ltd 2 | 3 | Permission to use, copy, modify, and/or 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. 4 | 5 | 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. 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all build clean tag prepare publish 2 | 3 | all: build 4 | 5 | build: 6 | jbuilder build @install 7 | 8 | clean: 9 | rm -fr _build 10 | 11 | VERSION := $$(opam query --version) 12 | NAME_VERSION := $$(opam query --name-version) 13 | ARCHIVE := $$(opam query --archive) 14 | 15 | tag: 16 | git tag -a "v$(VERSION)" -m "v$(VERSION)." 17 | git push origin v$(VERSION) 18 | 19 | prepare: 20 | opam publish prepare -r hardcaml $(NAME_VERSION) $(ARCHIVE) 21 | 22 | publish: 23 | opam publish submit -r hardcaml $(NAME_VERSION) 24 | rm -rf $(NAME_VERSION) 25 | 26 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Hardcaml Has A New Home! 2 | 3 | Hardcaml is now developed at [Jane Street](https://github.com/janestreet/hardcaml)! 4 | 5 | Various hardcaml libraries that lived under the ujamjar organisation have been updated, improved and released by Jane Street. 6 | 7 | # Deprecated version 8 | 9 | [![Build Status](https://travis-ci.org/ujamjar/hardcaml.svg?branch=master)](https://travis-ci.org/ujamjar/hardcaml) 10 | 11 | HardCaml is an OCaml library for designing hardware. 12 | 13 | * Express hardware designs in OCaml 14 | * Make generic designs using higher order functions, lists, maps, functors... 15 | * Simulate designs in OCaml 16 | * Convert to VHDL, Verilog, C 17 | * Write new modules to transform or analyse circuits, or provide new backends 18 | 19 | [Try it online!](http://ujamjar.github.io/hardcaml) 20 | 21 | # Build 22 | 23 | With opam 24 | 25 | ``` 26 | $ opam install hardcaml 27 | ``` 28 | 29 | The package (optionally) depends on `camlp4` for the syntax extension and `ctypes-foreign` for the C based simulator. The js\_of\_ocaml library requires `lwt` and `js_of_ocaml` 30 | 31 | To build locally use 32 | 33 | ``` 34 | $ ocaml pkg/pkg.ml build --with-camlp4 [true|false] --with-ctypes-foreigh [true|false] --with-lwt [true|false] --with-js_of_ocaml [true|false] 35 | ``` 36 | 37 | An `IOcamlJS` notebook kernel can also be built with 38 | 39 | ``` 40 | $ ocamlbuild kernel.hardcaml.js 41 | ``` 42 | 43 | # Related tools 44 | 45 | * [Examples and framework](https://github.com/ujamjar/hardcaml-examples) - simple to mildly complex example designs 46 | * [Waveform viewer](https://github.com/ujamjar/hardcaml-waveterm) - terminal based digital waveform viewer 47 | * [Icarus verilog VPI interface](https://github.com/ujamjar/hardcaml-vpi) - cosimulation with Icarus verilog 48 | * [LLVM simulator](https://github.com/ujamjar/hardcaml-llvmsim) - high speed, native code generating simulator 49 | 50 | # Other projects 51 | 52 | * [Reed-Solomon CODEC](https://github.com/ujamjar/hardcaml-reedsolomon) configurable Reed-Solomon encoder/decoder 53 | * [OpenRISC](https://github.com/ujamjar/hardcaml-mor1kx) direct port of mork1x cpu _very alpha, not tested as yet_ 54 | 55 | 56 | -------------------------------------------------------------------------------- /archive/fixed.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | module Round(B : Comb.S) : sig 12 | open B 13 | 14 | val negInfinity : t 15 | val posInfinity : t 16 | val toZero : t 17 | val awayFromZero : t 18 | val tieToNegInfinity : t 19 | val tieToPosInfinity : t 20 | val tieToZero : t 21 | val tieAwayFromZero : t 22 | val tieToNearestEven : t 23 | val tieToNearestOdd : t 24 | 25 | module type Generic = sig 26 | val sel : t 27 | end 28 | 29 | module type Unsigned = sig 30 | val f : int -> t -> t 31 | end 32 | module Unsigned : sig 33 | module NegInfinity : Unsigned 34 | module PosInfinity : Unsigned 35 | module ToZero : Unsigned 36 | module AwayFromZero : Unsigned 37 | module TieToNegInfinity : Unsigned 38 | module TieToPosInfinity : Unsigned 39 | module TieToZero : Unsigned 40 | module TieAwayFromZero : Unsigned 41 | module TieToNearestEven : Unsigned 42 | module TieToNearestOdd : Unsigned 43 | module Generic(G : Generic) : Unsigned 44 | end 45 | 46 | module type Signed = sig 47 | val f : int -> t -> t 48 | end 49 | module Signed : sig 50 | module NegInfinity : Signed 51 | module PosInfinity : Signed 52 | module ToZero : Signed 53 | module AwayFromZero : Signed 54 | module TieToNegInfinity : Signed 55 | module TieToPosInfinity : Signed 56 | module TieToZero : Signed 57 | module TieAwayFromZero : Signed 58 | module TieToNearestEven : Signed 59 | module TieToNearestOdd : Signed 60 | module Generic(G : Generic) : Signed 61 | end 62 | end 63 | 64 | module Overflow(B : Comb.S) : sig 65 | open B 66 | 67 | module type Unsigned = sig 68 | val f : int -> int -> t -> t 69 | end 70 | module Unsigned : sig 71 | module Wrap : Unsigned 72 | module Saturate : Unsigned 73 | end 74 | 75 | module type Signed = sig 76 | val f : int -> int -> t -> t 77 | end 78 | module Signed : sig 79 | module Wrap : Signed 80 | module Saturate : Signed 81 | end 82 | 83 | end 84 | 85 | module type Fixed = sig 86 | type bt 87 | type t = { s : bt; fp : int; } 88 | 89 | val mk : int -> bt -> t 90 | val int : t -> bt 91 | val frac : t -> bt 92 | val signal : t -> bt 93 | val width_int : t -> int 94 | val width_frac : t -> int 95 | 96 | val to_float : t -> float 97 | 98 | val select_int : t -> int -> bt 99 | val select_frac : t -> int -> bt 100 | val select : t -> int -> int -> t 101 | val norm : t list -> t list 102 | val norm2 : t -> t -> t * t 103 | val const : int -> int -> float -> t 104 | 105 | val (+:) : t -> t -> t 106 | val (-:) : t -> t -> t 107 | val ( *: ) : t -> t -> t 108 | val (==:) : t -> t -> bt 109 | val (<>:) : t -> t -> bt 110 | val (<:) : t -> t -> bt 111 | val (<=:) : t -> t -> bt 112 | val (>:) : t -> t -> bt 113 | val (>=:) : t -> t -> bt 114 | 115 | val mux : bt -> t list -> t 116 | 117 | val resize : t -> int -> int -> t 118 | end 119 | 120 | module Signed 121 | (B : Comb.S) 122 | (R : Round(B).Signed) 123 | (O : Overflow(B).Signed) : (Fixed with type bt = B.t) 124 | 125 | module Unsigned 126 | (B : Comb.S) 127 | (R : Round(B).Unsigned) 128 | (O : Overflow(B).Unsigned) : (Fixed with type bt = B.t) 129 | 130 | -------------------------------------------------------------------------------- /archive/verilog.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Generation of verilog netlists *) 12 | 13 | (** write a verilog netlist to the given channel from the given circuit *) 14 | val write : Circuit.t -> Buffer.t 15 | 16 | module Testbench : 17 | sig 18 | 19 | val write : string list -> string list -> Circuit.t -> Buffer.t 20 | 21 | end 22 | 23 | -------------------------------------------------------------------------------- /archive/verilog_ext.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open HardCaml 12 | 13 | let write chan circ = 14 | let b = Verilog.write circ in 15 | output_string chan (Buffer.contents b) 16 | 17 | module Testbench = 18 | struct 19 | 20 | let write chan a b c = 21 | let b = Verilog.Testbench.write a b c in 22 | output_string chan (Buffer.contents b) 23 | 24 | end 25 | 26 | module Hierarchy = 27 | struct 28 | 29 | open Signal.Types 30 | 31 | let vwrite = write 32 | let inst_name = function 33 | | Signal_inst(_,_,i) -> i.inst_name 34 | | _ -> failwith "expecting instantiation" 35 | 36 | let rec write ?(transforms=[]) database path circ = 37 | 38 | let name = Circuit.name circ in 39 | let f = open_out (path ^ name ^ ".v") in 40 | (* write this module *) 41 | let circ = 42 | List.fold_left (fun circ fn -> 43 | Transform.rewrite_circuit fn circ) circ transforms 44 | in 45 | vwrite f circ; 46 | close_out f; 47 | (* find instantiations *) 48 | let insts = Circuit.search Circuit.id 49 | (fun l s -> if is_inst s then s::l else l) 50 | [] (Circuit.outputs circ) 51 | in 52 | List.iter (fun inst -> 53 | let name = inst_name inst in 54 | try 55 | match Circuit.Hierarchy.get database name with 56 | | Some(c) -> write ~transforms:transforms database path c 57 | | None -> () 58 | with 59 | | Circuit.Failure(e) -> failwith ("error generating " ^ name ^ ": " ^ e) 60 | ) insts 61 | 62 | end 63 | 64 | -------------------------------------------------------------------------------- /archive/verilog_ext.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open HardCaml 12 | 13 | (** write a verilog netlist to the given channel from the given circuit *) 14 | val write : out_channel -> Circuit.t -> unit 15 | 16 | module Testbench : 17 | sig 18 | 19 | val write : out_channel -> string list -> string list -> Circuit.t -> unit 20 | 21 | end 22 | 23 | module Hierarchy : 24 | sig 25 | 26 | val write : ?transforms:(Transform.transform_fn list) -> 27 | Circuit.Hierarchy.database -> 28 | string -> Circuit.t -> unit 29 | 30 | end 31 | 32 | -------------------------------------------------------------------------------- /csim/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (library 4 | ((name "HardCamlCSim") 5 | (public_name "hardcaml-csim") 6 | (libraries (hardcaml ctypes.foreign)))) 7 | -------------------------------------------------------------------------------- /csim/sim.ml: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | module B = Bits.Comb.ArraybitsInt32 4 | 5 | type port = 6 | { 7 | name : string; 8 | width : int; 9 | get : unit -> Int32.t array; 10 | set : Int32.t array -> unit; 11 | } 12 | 13 | module C = struct 14 | 15 | open Ctypes 16 | open PosixTypes 17 | open Foreign 18 | 19 | type port_c 20 | let port_t : port_c structure typ = structure "port" 21 | let name = field port_t "name" string 22 | let width = field port_t "width" int 23 | let bits = field port_t "bits" (ptr int32_t) 24 | let () = seal port_t 25 | 26 | type sim_c 27 | let sim_t : sim_c structure typ = structure "simualator" 28 | let data = field sim_t "data" (ptr uint32_t) 29 | let regs = field sim_t "regs" (ptr uint32_t) 30 | let mems = field sim_t "mems" (ptr uint32_t) 31 | let muxes = field sim_t "muxes" (ptr uint32_t) 32 | let in_ports = field sim_t "in_ports" (ptr port_t) 33 | let num_in_ports = field sim_t "num_in_ports" int 34 | let out_ports = field sim_t "out_ports" (ptr port_t) 35 | let num_out_ports = field sim_t "num_out_ports" int 36 | let () = seal sim_t 37 | 38 | let destroy from = Foreign.foreign ~from "destroy" (ptr sim_t @-> returning void) 39 | let init from = 40 | let init = Foreign.foreign ~from "init" (void @-> returning (ptr sim_t)) in 41 | (fun () -> 42 | let sim = init () in 43 | let () = Gc.finalise (destroy from) sim in 44 | sim) 45 | let reset from = Foreign.foreign ~from "reset" (ptr sim_t @-> returning void) 46 | let cycle from = Foreign.foreign ~from "cycle" (ptr sim_t @-> returning void) 47 | 48 | let get_ports sim ports num_ports = 49 | let ports = getf (!@ sim) ports in 50 | let num = getf (!@ sim) num_ports in 51 | let carr = CArray.from_ptr ports num in 52 | Array.init num (fun i -> 53 | let p = CArray.get carr i in 54 | let w = getf p width in 55 | let wds = (w + 31) / 32 in 56 | let d = CArray.from_ptr (getf p bits) wds in 57 | let arr = Array.init wds (fun i -> 0l) in 58 | { 59 | name = getf p name; 60 | width = getf p width; 61 | get = (fun () -> 62 | for i=0 to wds-1 do 63 | arr.(i) <- CArray.get d i 64 | done; 65 | arr); 66 | set = (fun arr -> 67 | for i=0 to wds-1 do 68 | CArray.set d i arr.(i) 69 | done); 70 | }) 71 | 72 | end 73 | 74 | let compile_shared_lib name = 75 | match Unix.system ("gcc -shared -fPIC "^name^".c -o lib"^name^".so") with 76 | | Unix.WEXITED 0 -> () 77 | | _ -> failwith ("failed to compile "^name) 78 | 79 | let make_from_shared_lib dll = 80 | let module B = Bits.Comb.ArraybitsInt32 in 81 | let from = Dl.dlopen ~filename:dll ~flags:[Dl.RTLD_NOW] in 82 | let sim = C.init from () in 83 | let reset = C.reset from in 84 | let cycle = C.cycle from in 85 | let in_ports = C.get_ports sim C.in_ports C.num_in_ports in 86 | let out_ports = C.get_ports sim C.out_ports C.num_out_ports in 87 | let sim_in_ports = Array.map (fun p -> (p.name, ref (B.zero p.width)), p) in_ports in 88 | let sim_out_ports = Array.map (fun p -> (p.name, ref (B.zero p.width)), p) out_ports in 89 | let to_ports x = List.map fst @@ Array.to_list x in 90 | let sim_cycle_comb0 () = 91 | Array.iter 92 | (fun ((n,d),p) -> 93 | let (d,w) = !d in 94 | assert (w = p.width); 95 | p.set d) 96 | sim_in_ports; 97 | cycle sim; 98 | Array.iter 99 | (fun ((n,d),p) -> 100 | let (_,w) = !d in 101 | assert (w = p.width); 102 | d := (p.get (), w)) 103 | sim_out_ports; 104 | in 105 | let none () = () in 106 | { 107 | Cyclesim.Api.sim_in_ports = to_ports sim_in_ports; 108 | sim_out_ports = to_ports sim_out_ports; 109 | sim_out_ports_next = []; 110 | sim_internal_ports = []; 111 | sim_reset = (fun () -> reset sim); 112 | sim_cycle_check = none; 113 | sim_cycle_comb0; 114 | sim_cycle_seq = none; 115 | sim_cycle_comb1 = none; 116 | sim_lookup_signal = (fun _ -> failwith "csim: sim_lookup_singal"); 117 | sim_lookup_reg = (fun _ -> failwith "csim: sim_lookup_reg"); 118 | sim_lookup_memory = (fun _ -> failwith "csim: sim_lookup_mem"); 119 | } 120 | 121 | let make ?(name="tmp") circ = 122 | let cname = name ^ ".c" in 123 | let lname = "lib" ^ name ^ ".so" in 124 | let f = open_out cname in 125 | let () = Rtl.C.write (output_string f) circ in 126 | let () = close_out f in 127 | let () = compile_shared_lib name in 128 | make_from_shared_lib ("./" ^ lname) 129 | 130 | 131 | -------------------------------------------------------------------------------- /csim/sim.mli: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | module B : Comb.S with type t = Bits.Comb.ArraybitsInt32.t 4 | 5 | (** [compile_shared_lib name] compile, with gcc, [.c] to [lib.so] *) 6 | val compile_shared_lib : string -> unit 7 | 8 | (** Load the shared library (recommend using an absolute path) and create a simulator *) 9 | val make_from_shared_lib : string -> B.t Cyclesim.Api.cyclesim 10 | 11 | (** compile and load a C simulator (default name is "tmp") *) 12 | val make : ?name:string -> Circuit.t -> B.t Cyclesim.Api.cyclesim 13 | 14 | -------------------------------------------------------------------------------- /hardcaml-csim.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "andy.ray@ujamjar.com" 3 | authors: "andy.ray@ujamjar.com" 4 | homepage: "https://github.com/ujamjar/hardcaml" 5 | dev-repo: "https://github.com/ujamjar/hardcaml" 6 | bug-reports: "https://github.com/ujamjar/hardcaml/issues" 7 | build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] 8 | depends: [ 9 | "ocamlfind" {build} 10 | "jbuilder" {build & >= "1.0+beta8"} 11 | "base-bytes" 12 | "base-unix" 13 | "hardcaml" 14 | "ctypes" 15 | "ctypes-foreign" 16 | ] 17 | available: [ ocaml-version >= "4.01.0" ] 18 | name: "hardcaml-csim" 19 | version: "1.3.0" 20 | license: "ISC" 21 | 22 | -------------------------------------------------------------------------------- /hardcaml-js.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "andy.ray@ujamjar.com" 3 | authors: "andy.ray@ujamjar.com" 4 | homepage: "https://github.com/ujamjar/hardcaml" 5 | dev-repo: "https://github.com/ujamjar/hardcaml" 6 | bug-reports: "https://github.com/ujamjar/hardcaml/issues" 7 | build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] 8 | depends: [ 9 | "ocamlfind" {build} 10 | "jbuilder" {build & >= "1.0+beta8"} 11 | "base-bytes" 12 | "base-unix" 13 | "hardcaml" 14 | "js_of_ocaml" { >= "3.0" } 15 | ] 16 | available: [ ocaml-version >= "4.01.0" ] 17 | name: "hardcaml-js" 18 | version: "1.3.0" 19 | license: "ISC" 20 | 21 | -------------------------------------------------------------------------------- /hardcaml-lwttb.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "andy.ray@ujamjar.com" 3 | authors: "andy.ray@ujamjar.com" 4 | homepage: "https://github.com/ujamjar/hardcaml" 5 | dev-repo: "https://github.com/ujamjar/hardcaml" 6 | bug-reports: "https://github.com/ujamjar/hardcaml/issues" 7 | build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] 8 | depends: [ 9 | "ocamlfind" {build} 10 | "jbuilder" {build & >= "1.0+beta8"} 11 | "base-bytes" 12 | "base-unix" 13 | "hardcaml" 14 | "lwt" 15 | ] 16 | available: [ ocaml-version >= "4.01.0" ] 17 | name: "hardcaml-lwttb" 18 | version: "1.3.0" 19 | license: "ISC" 20 | 21 | -------------------------------------------------------------------------------- /hardcaml.opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "andy.ray@ujamjar.com" 3 | authors: "andy.ray@ujamjar.com" 4 | homepage: "https://github.com/ujamjar/hardcaml" 5 | dev-repo: "https://github.com/ujamjar/hardcaml" 6 | bug-reports: "https://github.com/ujamjar/hardcaml/issues" 7 | build: [ ["jbuilder" "build" "-p" name "-j" jobs] ] 8 | depends: [ 9 | "ocamlfind" {build} 10 | "jbuilder" {build & >= "1.0+beta8"} 11 | "base-bytes" 12 | "base-unix" 13 | "astring" 14 | ] 15 | available: [ ocaml-version >= "4.01.0" ] 16 | name: "hardcaml" 17 | version: "1.3.0" 18 | license: "ISC" 19 | 20 | -------------------------------------------------------------------------------- /js/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (library 4 | ((name "HardCamlJS") 5 | (public_name "hardcaml-js") 6 | (libraries (hardcaml js_of_ocaml)) 7 | (preprocess (pps (js_of_ocaml-ppx))))) 8 | 9 | -------------------------------------------------------------------------------- /js/wave.mli: -------------------------------------------------------------------------------- 1 | module B : HardCaml.Comb.S with type t = HardCaml.Bits.Comb.IntbitsList.t 2 | 3 | type exarray = { mutable len : int; mutable data : B.t array; } 4 | val make : unit -> exarray 5 | val extend : exarray -> unit 6 | val set : exarray -> int -> B.t -> unit 7 | val get : exarray -> int -> B.t 8 | val length : exarray -> int 9 | val data : exarray -> B.t array 10 | 11 | type wave = { name : string; nbits : int; data : exarray; } 12 | type waves = wave array 13 | 14 | val wrap : B.t HardCaml.Cyclesim.Api.cyclesim -> B.t HardCaml.Cyclesim.Api.cyclesim * wave array 15 | 16 | module Gui : 17 | sig 18 | val render_1 : 19 | int * int -> 20 | int * int -> 21 | int -> Dom_html.canvasRenderingContext2D Js.t -> B.t array -> unit 22 | val render_n : 23 | ('a -> string) -> 24 | int * int -> 25 | int * int -> int -> Dom_html.canvasRenderingContext2D Js.t -> 'a array -> unit 26 | 27 | val mk_wave_table : #Dom.node Js.t -> int -> int -> wave array -> unit 28 | end 29 | 30 | -------------------------------------------------------------------------------- /lwttb/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (library 4 | ((name "HardCamlLWTTB") 5 | (public_name "hardcaml-lwttb") 6 | (libraries (hardcaml lwt)))) 7 | 8 | -------------------------------------------------------------------------------- /lwttb/lwtsim.ml: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | module Make(B : Comb.S)(I : Interface.S)(O : Interface.S) = struct 4 | 5 | module S = Interface.Sim(B)(I)(O) 6 | 7 | let make name f = 8 | let circ,sim,i,o,n = S.make name f in 9 | let reset () = Cyclesim.Api.reset sim in 10 | let cycle () i' = 11 | ignore @@ I.map2 (:=) i i'; 12 | Cyclesim.Api.cycle sim; 13 | (), O.map (!) o, O.map (!) n 14 | in 15 | reset, cycle 16 | 17 | include Tb.Make(struct type state = unit end)(B)(I)(O) 18 | 19 | end 20 | 21 | -------------------------------------------------------------------------------- /lwttb/lwtsim.mli: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | module Make(B : Comb.S)(I : Interface.S)(O : Interface.S) : sig 4 | 5 | include Tb.S 6 | with type state = unit 7 | and type b = B.t 8 | and type 'a i = 'a I.t 9 | and type 'a o = 'a O.t 10 | 11 | val make : 12 | string -> 13 | (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 14 | (unit -> unit) * (unit -> B.t I.t -> unit * B.t O.t * B.t O.t) 15 | 16 | end 17 | 18 | -------------------------------------------------------------------------------- /lwttb/tb.ml: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | module type State = sig 4 | type state 5 | end 6 | 7 | module type S = sig 8 | 9 | type state 10 | type b 11 | type 'a i 12 | type 'a o 13 | 14 | type reset = unit -> state 15 | type cycle = state -> b i -> state * b o * b o 16 | 17 | type task_req 18 | 19 | type t = private 20 | { 21 | vreq : task_req Lwt_mvar.t; 22 | vresp : (b o * b o) Lwt_mvar.t; 23 | children : t list; 24 | inputs : b option i; 25 | log : log option; 26 | } 27 | 28 | and log = t -> unit Lwt.t 29 | 30 | type task = t -> t Lwt.t 31 | 32 | val cycle1 : t -> (t * b o * b o) Lwt.t 33 | 34 | val cycle : ?n:int -> t -> (t * b o * b o) Lwt.t 35 | 36 | val spawn : ?log:log -> task -> t -> t Lwt.t 37 | 38 | val repeat : int -> task -> t -> t Lwt.t 39 | 40 | val delay : int -> task -> t -> t Lwt.t 41 | 42 | val return : 'a -> 'a Lwt.t 43 | 44 | val return_cycle : t -> t Lwt.t 45 | 46 | val i : bool i i 47 | 48 | val inone : b option i 49 | 50 | val set : bool i -> b -> t -> t Lwt.t 51 | 52 | val setsome : b option i -> t -> t Lwt.t 53 | 54 | val setall : b i -> t -> t Lwt.t 55 | 56 | val run : ?log:log -> (reset * cycle) -> task -> unit Lwt.t 57 | 58 | end 59 | 60 | module Make(State : State)(B : Comb.S)(I : Interface.S)(O : Interface.S) = struct 61 | include State 62 | open Lwt.Infix 63 | 64 | type b = B.t 65 | type 'a i = 'a I.t 66 | type 'a o = 'a O.t 67 | 68 | type reset = unit -> state 69 | type cycle = state -> b i -> state * b o * b o 70 | 71 | type task_req = 72 | | Cycle of b option I.t 73 | | Finish 74 | 75 | type t = 76 | { 77 | (* mailbox variables used to synchronise to the clock cycle *) 78 | vreq : task_req Lwt_mvar.t; 79 | vresp : (B.t O.t * B.t O.t) Lwt_mvar.t; 80 | (* child tasks *) 81 | children : t list; 82 | (* inputs *) 83 | inputs : B.t option I.t; 84 | (* cycle logging function *) 85 | log : log option; 86 | } 87 | 88 | 89 | and log = t -> unit Lwt.t 90 | 91 | type task = t -> t Lwt.t 92 | 93 | let merge i1 i2 = I.map2 94 | (fun i1 i2 -> 95 | match i1, i2 with 96 | | _, Some(d) -> Some(d) 97 | | Some(d), _ -> Some(d) 98 | | _ -> None) i1 i2 99 | 100 | let inone = I.map (fun _ -> None) I.t 101 | 102 | let dolog t children inputs = 103 | match t.log with 104 | | None -> Lwt.return () 105 | | Some(f) -> f { t with children; inputs } 106 | 107 | let cycle1 t = 108 | (* wait for active children to notify *) 109 | Lwt_list.filter_map_p 110 | (fun t -> 111 | Lwt_mvar.take t.vreq >>= function Cycle i -> Lwt.return_some (t,i) 112 | | Finish -> Lwt.return_none) 113 | t.children >>= fun children -> 114 | let children = List.map fst children and inputs = List.map snd children in 115 | let inputs = List.fold_left merge t.inputs inputs in 116 | dolog t children inputs >>= fun () -> 117 | (* notify parent *) 118 | Lwt_mvar.put t.vreq (Cycle inputs) >>= fun () -> 119 | (* wait for state from parent *) 120 | Lwt_mvar.take t.vresp >>= fun (o, n) -> 121 | (* broadcast to children *) 122 | Lwt_list.iter_p (fun t -> Lwt_mvar.put t.vresp (o, n)) children >>= fun () -> 123 | let t = { t with children; inputs=inone } in 124 | Lwt.return (t, o, n) 125 | 126 | let rec cycle ?(n=1) t = 127 | if n < 1 then Lwt.fail_with "cycle must be for >= 1 cycle" 128 | else if n = 1 then 129 | cycle1 t 130 | else 131 | cycle1 t >>= fun (t,_,_) -> cycle ~n:(n-1) t 132 | 133 | let rec with_finish t = 134 | if t.children = [] then 135 | Lwt_mvar.put t.vreq Finish >>= fun () -> Lwt.return t 136 | else 137 | (* keep running while children are active *) 138 | cycle1 t >>= fun (t,_,_) -> with_finish t 139 | 140 | let task' ?log () = 141 | { 142 | vreq = Lwt_mvar.create_empty (); 143 | vresp = Lwt_mvar.create_empty (); 144 | children = []; 145 | inputs = inone; 146 | log; 147 | } 148 | 149 | let async task t = Lwt.async (fun () -> task t >>= with_finish) 150 | 151 | let spawn ?log k t = 152 | (* generate communications variables *) 153 | let n = task' ?log () in 154 | (* run the thread *) 155 | let () = async k n in 156 | (* update children *) 157 | Lwt.return { t with children = n :: t.children } 158 | 159 | let rec repeat n f t = 160 | if n <= 0 then Lwt.return t 161 | else f t >>= fun t -> repeat (n-1) f t 162 | 163 | let rec delay n f t = 164 | if n <= 0 then f t 165 | else 166 | cycle t >>= fun (t,_,_) -> delay (n-1) f t 167 | 168 | let i = 169 | I.map (fun (n,_) -> I.map (fun (m,_) -> n=m) I.t) I.t 170 | 171 | let set fld v t = 172 | Lwt.return 173 | { t with inputs = I.map2 (fun yn prv -> if yn then Some(v) else prv) fld t.inputs } 174 | 175 | let setsome v t = Lwt.return { t with inputs = merge t.inputs v } 176 | 177 | let setall v t = Lwt.return { t with inputs = I.map (fun x -> Some(x)) v } 178 | 179 | let return = Lwt.return 180 | 181 | let return_cycle sim = cycle1 sim >>= fun (sim,_,_) -> return sim 182 | 183 | let run ?log (reset, cycle) task = 184 | 185 | let t = task' ?log () in 186 | let () = async task t in 187 | 188 | let rec loop prev sim = 189 | Lwt_mvar.take t.vreq >>= function 190 | | Cycle inputs -> begin 191 | (* apply inputs *) 192 | let inputs = 193 | I.map2 (fun p d -> match d with 194 | | None -> p 195 | | Some(d) -> d) prev inputs 196 | in 197 | (* simulation cycle *) 198 | let sim, o, n = cycle sim inputs in 199 | (* send back outputs *) 200 | Lwt_mvar.put t.vresp (o, n) >>= fun () -> 201 | (* loop *) 202 | loop inputs sim 203 | end 204 | | Finish -> Lwt.return () 205 | in 206 | 207 | loop 208 | I.(map (fun (_,b) -> B.zero b) t) 209 | (reset ()) 210 | 211 | end 212 | 213 | -------------------------------------------------------------------------------- /lwttb/tb.mli: -------------------------------------------------------------------------------- 1 | (** 2 | 3 | {2 HardCaml LWT testbench framework. } 4 | 5 | Testbenches in HardCaml are synchronised to a [cycle] function 6 | which updates the simulation state. The hardware under test may 7 | have 1 or more relatively distinct input/output interfaces (for 8 | example multiple input/output fifos, register interfaces, ddr 9 | interfaces etc). 10 | 11 | Tranditionally, if more than 1 interface needed modelling in the 12 | testbench, then each process would have to be converted into a 13 | statemachine that was updated as part of the simulation cycle. 14 | 15 | This code allows for multiple processes to be run in parallel 16 | while still synchronising around the clock. 17 | 18 | {2 Programming model} 19 | 20 | A testbench consists of a number of tasks of type [t -> t Lwt.t]. 21 | The type [t] holds the simulation state and allows each Lwt 22 | thread to be synchronised with the simulation cycle. [t] must 23 | be passed through each API function (it is purely functional 24 | and gets updated by successive API functions). 25 | 26 | The functions [cycle1] and [spawn] provide the core API. 27 | [cycle1] synchronises all tasks together, collects circuit 28 | inputs, runs the simulation cycle and distributes circuit outputs. 29 | [spawn] allows nww tasks to start running (within the current 30 | simulation cycle). Tasks are arranged in a tree like fashion. 31 | The inital task is the root, and spawns within spawns are 32 | (nearer to) the leaves. 33 | 34 | The [set] function (along with [setsome] and [setall]) allow 35 | tasks to set circuit inputs. Multiple tasks can set the same 36 | input and sets nearer leaves take priority. 37 | 38 | note; this is the current behaviour and may change or be 39 | extended ie to allow priority to be specified. 40 | The priority among tasks at the same level is the 41 | latest spawned task takes precedence. 42 | 43 | *) 44 | open HardCaml 45 | 46 | module type State = sig 47 | type state 48 | end 49 | 50 | module type S = sig 51 | 52 | (** simulation state type *) 53 | type state 54 | 55 | (** bit vector type used to implement simulator calculations *) 56 | type b 57 | 58 | (** circuit inputs *) 59 | type 'a i 60 | 61 | (** circuit outputs *) 62 | type 'a o 63 | 64 | (* simulator reset function *) 65 | type reset = unit -> state 66 | 67 | (* simulator cycle function *) 68 | type cycle = state -> b i -> state * b o * b o 69 | 70 | type task_req 71 | 72 | (** simulation testbench data type *) 73 | type t = private 74 | { 75 | (* mailbox variables used to synchronise to the clock cycle *) 76 | vreq : task_req Lwt_mvar.t; 77 | vresp : (b o * b o) Lwt_mvar.t; 78 | (* child tasks *) 79 | children : t list; 80 | (* inputs *) 81 | inputs : b option i; 82 | (* cycle logging function *) 83 | log : log option; 84 | } 85 | 86 | and log = t -> unit Lwt.t 87 | 88 | (** type of simulation tasks synchronised to the clock *) 89 | type task = t -> t Lwt.t 90 | 91 | (* {2 cycles, task spawning and utility functions} *) 92 | 93 | (** cycle the clock, return circuit outputs *) 94 | val cycle1 : t -> (t * b o * b o) Lwt.t 95 | 96 | (** cycle the clock n>=1 times *) 97 | val cycle : ?n:int -> t -> (t * b o * b o) Lwt.t 98 | 99 | (** spawn a new simulation task synchronised to each cycle *) 100 | val spawn : ?log:log -> task -> t -> t Lwt.t 101 | 102 | (** [repeat n task sim] repeats the task n times *) 103 | val repeat : int -> task -> t -> t Lwt.t 104 | 105 | (** [delay n task sim] delay for n cycles then run task *) 106 | val delay : int -> task -> t -> t Lwt.t 107 | 108 | (** [Lwt.return] *) 109 | val return : 'a -> 'a Lwt.t 110 | 111 | (** perform a simulation cycle and return *) 112 | val return_cycle : t -> t Lwt.t 113 | 114 | (** {2 setting circuit inputs} *) 115 | 116 | (** input field accessors *) 117 | val i : bool i i 118 | 119 | (** input structure with all fields set to none *) 120 | val inone : b option i 121 | 122 | (** set an input field *) 123 | val set : bool i -> b -> t -> t Lwt.t 124 | 125 | (** set some inputs *) 126 | val setsome : b option i -> t -> t Lwt.t 127 | 128 | (** set all inputs *) 129 | val setall : b i -> t -> t Lwt.t 130 | 131 | (** {2 testbench simulation} *) 132 | 133 | (** run testbench *) 134 | val run : ?log:log -> (reset * cycle) -> task -> unit Lwt.t 135 | 136 | end 137 | 138 | module Make(State : State) (B : Comb.S)(I : Interface.S)(O : Interface.S) : 139 | S with type state = State.state 140 | and type b = B.t 141 | and type 'a i = 'a I.t 142 | and type 'a o = 'a O.t 143 | 144 | -------------------------------------------------------------------------------- /notebooks/01-design-flow.ipynb: -------------------------------------------------------------------------------- 1 | {"metadata":{"name":"","language":"ocaml"},"worksheets":[{"cells":[{"metadata":{},"cell_type":"heading","source":"HardCaml Design Flow","level":1},{"metadata":{},"cell_type":"markdown","source":"I will start with an overview of designing a complex IP core in HardCaml. Later I will discuss some specific techniques that can be employed to help raise the level of abstraction over standard RTL design flows."},{"metadata":{},"cell_type":"heading","source":"IP Core Design Flow","level":2},{"metadata":{},"cell_type":"heading","source":"Reference Model","level":4},{"metadata":{},"cell_type":"markdown","source":"One of the key advantages to designing hardware with HardCaml is the ability to keep both a reference model and the hardware model in the same language. Indeed in the same program.\n\nThis offers the designer the ability to cross check between the models at almost completely arbitrary points.\n\nIn contrast many standard design flows use a different language for the reference model (probably C) and hardware design (Verilog or VHDL).\n\nWhen iterating between models removing the language barrier, and associated trace or debug files, is a big win for HardCaml."},{"metadata":{},"cell_type":"heading","source":"New Abstractions Levels","level":4},{"metadata":{},"cell_type":"markdown","source":"A further advantage to bringing the software model and hardware design together is that it allows a both to be iteratively refined towards the final goal.\n\n1. Using the combinatorial API shallow embedding a number of architectural aspects of the hardware design can be resolved before any detailed work on the internal timing of the design.\n2. In the extreme a complete combinatorial version of a core can (sometimes) be developed, then reused for the timed version.\n3. A mixture combinatorial logic to bit accurately describe the design and OCaml control code can be used to find an appropriate timed model.\n4. Hardware sub-modules can be developed and integrated back into the software model."},{"metadata":{},"cell_type":"heading","source":"Example","level":4},{"metadata":{},"cell_type":"markdown","source":"Here's an example design flow recently used to develop a Reed-Solomon ECC core.\n\n1. Develop reference model while learning algorithm.\n2. Refinement of Galois field code; unify the hardware/software.\n3. Development of hardware submodules: syndromes, berlekamp-massy, forney, chein. Test each within reference model.\n 1. Testing combinatorial logic\n 2. Some simulation\n4. Integration - simulation"},{"metadata":{},"cell_type":"heading","source":"Other techniques","level":2},{"metadata":{},"cell_type":"heading","source":"Fixed point data paths","level":4},{"metadata":{},"cell_type":"markdown","source":"Efficient hardware usually requires conversion of floating point to fixed point arithmetic. Ensuring enough precision is a task resolved by either\n\n1. Matlab or it's various cousins\n2. Hacking within the reference model\n3. Creating parametrised data paths and testing in simulation\n\nHardCaml includes a Fixed point library making tasks 2 and 3 much simpler. Fixed points can be tracked throughout computations by the library along with precise control of rounding and overflow modes.\n\nIt's possible to go further, however, by augmenting the fixed point library. One example is self sizing data paths. Given knowledge of the ranges of input values the computations can track the input/output ranges of intermediate values and size buses appropriately. This approach was used to implement an IEEE compliant DCT with the only variable the precision of the sin tables.\n\nIn addition for heavily arithmetic circuits it's possible to imagine a way of tracking and specifying the error tolerances of certain arithmetic nodes and having the circuit optimise itself."},{"metadata":{},"cell_type":"heading","source":"Specialised Domain Specific Languages","level":4},{"metadata":{},"cell_type":"markdown","source":"Probably the most interesting possibility is the ability to write spcialized domain specific languages. At their simplest something like the fixed point library can be considered a DSL. At their most complex a high level synthesis compiler could be written with HardCaml as a back end.\n\nIn between these extremes are various specialized DSL's that can leverage a little bit of compiler like technology to solve specific problems."}],"metadata":{}}],"nbformat":3,"nbformat_minor":0} -------------------------------------------------------------------------------- /notebooks/05-guarded-processes-and-statemachines.ipynb: -------------------------------------------------------------------------------- 1 | {"metadata":{"name":"","language":"ocaml"},"worksheets":[{"cells":[{"metadata":{},"cell_type":"heading","source":"Guarded module","level":1},{"metadata":{},"input":"open HardCaml\nopen Signal.Comb\nopen Signal.Seq\nopen Signal.Guarded\nopen Signal.Types","cell_type":"code","prompt_number":1,"outputs":[],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"The guarded module provides a small DSL to describe something similar to VHDL `processes` or Verilog `always` blocks.\n\nHere's the up-down counter from an earlier tutorial described this way."},{"metadata":{},"input":"let up_down_counter clear up down = \n let counter = g_reg { r_sync with reg_clear = clear } empty 8 in\n let () = compile [\n g_when (up ^: down) [\n g_when (up) [ counter $== counter#q +:. 1 ];\n g_when (down) [ counter $== counter#q -:. 1 ];\n ]\n ] in\n counter#q","cell_type":"code","prompt_number":2,"outputs":[{"output_type":"pyout","prompt_number":2,"html":"
val up_down_counter : t -> t -> t -> t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"This compares to VHDL as follows\n\n```vhdl\narchitecture rtl ...\n signal counter : unsigned(7 downto 0);\nbegin\n process (clock) \n begin\n if rising_edge(clock) then\n if clear='1' then\n counter <= (others=>'0');\n else\n if up xor down then\n if up then \n counter <= counter + 1;\n end if;\n if down then \n counter <= counter - 1;\n end if;\n end if;\n end if;\n end if;\n end process;\nend architecture;\n```\n\nThe first difference to note is in HardCaml the type of a `guarded variable` is specified before the assignments section. In VHDL (and Verilog) this is inferred using a template (sensitivity list and rising_edge). The two main functions for constructing these guarded values are `g_reg` and `g_wire`. The former describes a register which holds it's value between clock cycles. The later is for combinatorial values (a default value is provided for when there is no assignment). Here lies a useful distinction between HardCaml and VHDL/Verilog - registered and combinatorial values may be updated in the same code block.\n\nThe logic in HardCaml is specified within the list passed to the compile function. What goes into this list constitutes the `Guarded DSL`. The compile function takes the DSL and turns it back into structural RTL.\n\nThe main idea is to provide if/switch like statements to control when assignments occur to guarded variables."},{"metadata":{},"input":"g_if","cell_type":"code","prompt_number":3,"outputs":[{"output_type":"pyout","prompt_number":3,"html":"
- : t -> statements -> statements -> statement = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"`g_if` takes a control signal and 2 lists of guarded statements to execute dependant on the control signal. `g_switch` is similar except it allows multiple paths of control flow."},{"metadata":{},"input":"g_switch","cell_type":"code","prompt_number":4,"outputs":[{"output_type":"pyout","prompt_number":4,"html":"
- : t -> t cases -> statement = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"To actually perform assignments we use this operator."},{"metadata":{},"input":"($==)","cell_type":"code","prompt_number":5,"outputs":[{"output_type":"pyout","prompt_number":5,"html":"
- : variable -> t -> statement = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"The final thing to note is the only place where a guarded variable is actually allowed is the on the left hand side of an assignment. Everywhere else you use either standard HardCaml signals or other statement types. You can read guarded variables from code blocks (or outside them) using the **#q** method."},{"metadata":{},"input":"let x = g_wire gnd","cell_type":"code","prompt_number":6,"outputs":[{"output_type":"pyout","prompt_number":6,"html":"
val x : variable = <obj>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"x#q","cell_type":"code","prompt_number":7,"outputs":[{"output_type":"pyout","prompt_number":7,"html":"
- : t =\nSignal_wire ({s_id = 37L; s_names = []; s_width = 1; s_deps = []},\n {contents = Signal_empty})\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"How values update","level":2},{"metadata":{},"cell_type":"markdown","source":"`guarded variables` are not variables in the traditional sense. The semantics are closer to signals in VHDL (or non-blocking assignments in Verilog).\n\nWhen multiple assignments are executed in a particular control flow within a code block the last one *wins*. Say we execute the following with x currently set to 1.\n\n```\nx = x + 2\nif (true) x = x + 3\n```\n\nWith *normal* variables we would expect a result of 6 (1+2+3). In actual fact we get 4 (1+3) - the `x = x + 3` is the (only) statement that affects the final result.\n\nThe basic rule is the input value of x is the same for all statements in a code block. The output value (or next value of a wire or register) is the last assignment statement to execute."},{"metadata":{},"cell_type":"heading","source":"Statemachines","level":2},{"metadata":{},"cell_type":"markdown","source":"One of the main purposes of the guarded module is to describe statemachines. As per VHDL/Verilog this is done with a switch like statement.\n\nFor convenience this is wrapped up in a special set of functions.\n\nFirst here are a couple of interface signals used below."},{"metadata":{},"input":"let start, stall = vdd, gnd\nlet x = g_wire (consti 8 0)","cell_type":"code","prompt_number":8,"outputs":[{"output_type":"pyout","prompt_number":8,"html":"
val start : t =\n  Signal_const ({s_id = 1L; s_names = ["vdd"]; s_width = 1; s_deps = []},\n   "1")\nval stall : t =\n  Signal_const ({s_id = 2L; s_names = ["gnd"]; s_width = 1; s_deps = []},\n   "0")\n
","metadata":{}},{"output_type":"pyout","prompt_number":8,"html":"
val x : variable = <obj>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"This statement defines the statemachine. It returns the function `machine` used to declare the statemachine and `state` used to set the next state. The hidden value is the state register itself (not all that useful in most cases)."},{"metadata":{},"input":"let _,machine,state = statemachine r_sync enable [ `One; `Two; `Three ] ","cell_type":"code","prompt_number":9,"outputs":[{"output_type":"pyout","prompt_number":9,"html":"
val machine : _[> `One | `Three | `Two ] cases -> statement = <fun>\nval state : _[> `One | `Three | `Two ] -> statement = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Now for the statemachine. Note that the result of the machine function is just a guarded statement and it can be surrounded by arbitrary other statements (or other statemachines)."},{"metadata":{},"input":"compile [\n machine [\n `One, [\n x $==. 10;\n g_when start [ state `Two; ];\n ];\n `Two, [\n x $==. 20;\n state `Three;\n ];\n `Three, [\n x $==. 30;\n g_when stall [ state `One; ];\n ];\n ];\n]","cell_type":"code","prompt_number":10,"outputs":[{"output_type":"pyout","prompt_number":10,"html":"
- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false}],"metadata":{}}],"nbformat":3,"nbformat_minor":0} -------------------------------------------------------------------------------- /notebooks/31-lfsr.ipynb: -------------------------------------------------------------------------------- 1 | {"metadata":{"name":"","language":"ocaml"},"worksheets":[{"cells":[{"metadata":{},"cell_type":"heading","source":"Linear Feedback Shift Registers","level":1},{"metadata":{},"cell_type":"markdown","source":"A linear feedback shift register is a shift register whose input is a linear function of the previous state. An appropriately designed linear function can lead to a very long sequence of unique states, however, after some time it will eventually repeat. For a shift register of m bits the longest sequence has $2^m−1$ discrete states. The missing value, either all zeros or all ones depending on how the linear function is constructed, will never change so the LFSR should never be initialized to this value.\n\nThe linear function for a LFSR is usually constructed by XOR'ing certain taps of the state together.\n\nBy taking the output bit (either the most or least significant bit of the state) of the LFSR a psuedo-random sequence of 1's and 0's is generated. This can be useful in applications such as direct-sequence spread spectrum radio applications, generating white noise or for scambling.\n\nAlternatively, the entire state could be a considered as a binary number. As the LFSR is clocked a sequence of psuedo-random numbers is generated. The 'rand' function in the standard C library is often implemented using this technique."},{"metadata":{},"cell_type":"heading","source":"Types of LFSR","level":1},{"metadata":{},"cell_type":"markdown","source":"LFSR's can be constructed either in Fibonacci or Galois form. In Fibonacci form the XOR gates are concatenated together to form the new input value. For example 4 taps would require 3 2-input XOR gates connected in series.\n\nIn Galois form XOR gates are placed between certain elements of the state. In this way the gate delay is reduced to 1.\n\nIn both forms the XOR gates can be replaced by XNOR gates. The main difference is that using XOR gates all zeros is the invalid state value, while when using XNOR all ones is the invalid state value."},{"metadata":{},"cell_type":"heading","source":"Implementation","level":1},{"metadata":{},"input":"open HardCaml","cell_type":"code","prompt_number":1,"outputs":[],"language":"python","collapsed":false},{"metadata":{},"input":"module Lfsr(B : Comb.S) = struct\n open B\n\n let galois (^:) poly = \n let poly = List.rev (List.tl poly) in\n let rec f n poly lo state =\n match poly with \n | [] -> [select_e state (width state - 1) n]\n | p :: poly ->\n select_e state (p-1) n :: \n (lo ^: bit state p) :: \n f (p+1) poly lo state\n in\n let mk state = \n let l = bit state 0 in\n let s = f 0 poly l state in\n let s = concat_e (List.rev s) in\n l @: (msbs s)\n in\n mk \n \n let fibonacci (^:) poly state = \n let p = List.map (fun i -> bit state (i-1)) poly in\n let f = List.fold_left (fun a p -> a ^: p) (List.hd p) (List.tl p) in\n lsbs state @: f\n\nend","cell_type":"code","prompt_number":2,"outputs":[{"output_type":"pyout","prompt_number":2,"html":"
module Lfsr :\n  functor (B : HardCaml.Comb.S) ->\n    sig\n      val galois : (B.t -> B.t -> B.t) -> int list -> B.t -> B.t\n      val fibonacci : (B.t -> B.t -> B.t) -> int list -> B.t -> B.t\n    end\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Some precomputed maximal length LFSR's for between 2 and 168 bits. `counterpart taps.(i)` is another maximal length sequence."},{"metadata":{},"input":"let taps = [|\n[]; []; [2;1]; [3;2]; [4;3]; [5;3]; [6;5]; [7;6]; [8;6;5;4]; [9;5]; [10;7];\n[11;9]; [12;6;4;1]; [13;4;3;1]; [14;5;3;1]; [15;14]; [16;15;13;4]; [17;14];\n[18;11]; [19;6;2;1]; [20;17]; [21;19]; [22;21]; [23;18]; [24;23;22;17];\n[25;22]; [26;6;2;1]; [27;5;2;1]; [28;25]; [29;27]; [30;6;4;1]; [31;28];\n[32;22;2;1]; [33;20]; [34;27;2;1]; [35;33]; [36;25]; [37;5;4;3;2;1];\n[38;6;5;1]; [39;35]; [40;38;21;19]; [41;38]; [42;41;20;19]; [43;42;38;37];\n[44;43;18;17]; [45;44;42;41]; [46;45;26;25]; [47;42]; [48;47;21;20]; [49;40];\n[50;49;24;23]; [51;50;36;35]; [52;49]; [53;52;38;37]; [54;53;18;17]; [55;31];\n[56;55;35;34]; [57;50]; [58;39]; [59;58;38;37]; [60;59]; [61;60;46;45];\n[62;61;6;5]; [63;62]; [64;63;61;60]; [65;47]; [66;65;57;56]; [67;66;58;57];\n[68;59]; [69;67;42;40]; [70;69;55;54]; [71;65]; [72;66;25;19]; [73;48];\n[74;73;59;58]; [75;74;65;64]; [76;75;41;40]; [77;76;47;46]; [78;77;59;58];\n[79;70]; [80;79;43;42]; [81;77]; [82;79;47;44]; [83;82;38;37]; [84;71];\n[85;84;58;57]; [86;85;74;73]; [87;74]; [88;87;17;16]; [89;51]; [90;89;72;71];\n[91;90;8;7]; [92;91;80;79]; [93;91]; [94;73]; [95;84]; [96;94;49;47];\n[97;91]; [98;87]; [99;97;54;52]; [100;63]; [101;100;95;94]; [102;101;36;35];\n[103;94]; [104;103;94;93]; [105;89]; [106;91]; [107;105;44;42]; [108;77];\n[109;108;103;102]; [110;109;98;97]; [111;101]; [112;110;69;67]; [113;104];\n[114;113;33;32]; [115;114;101;100]; [116;115;46;45]; [117;115;99;97];\n[118;85]; [119;111]; [120;113;9;2]; [121;103]; [122;121;63;62]; [123;121];\n[124;87]; [125;124;18;17]; [126;125;90;89]; [127;126]; [128;126;101;99];\n[129;124]; [130;127]; [131;130;84;83]; [132;103]; [133;132;82;81]; [134;77];\n[135;124]; [136;135;11;10]; [137;116]; [138;137;131;130]; [139;136;134;131];\n[140;111]; [141;140;110;109]; [142;121]; [143;142;123;122]; [144;143;75;74];\n[145;93]; [146;145;87;86]; [147;146;110;109]; [148;121]; [149;148;40;39];\n[150;97]; [151;148]; [152;151;87;86]; [153;152]; [154;152;27;25];\n[155;154;124;123]; [156;155;41;40]; [157;156;131;130]; [158;157;132;131];\n[159;128]; [160;159;142;141]; [161;143]; [162;161;75;74]; [163;162;104;103];\n[164;163;151;150]; [165;164;135;134]; [166;165;128;127]; [167;161];\n[168;166;153;151];\n|]\n\nlet counterpart taps = \n let n,t = List.hd taps, List.tl taps in\n let t = List.map (fun t -> n - t) t in\n n :: t","cell_type":"code","prompt_number":3,"outputs":[{"output_type":"pyout","prompt_number":3,"html":"
val taps : int list array =\n  [|[]; []; [2; 1]; [3; 2]; [4; 3]; [5; 3]; [6; 5]; [7; 6]; [8; 6; 5; 4];\n    [9; 5]; [10; 7]; [11; 9]; [12; 6; 4; 1]; [13; 4; 3; 1]; [14; 5; 3; 1];\n    [15; 14]; [16; 15; 13; 4]; [17; 14]; [18; 11]; [19; 6; 2; 1]; [20; 17];\n    [21; 19]; [22; 21]; [23; 18]; [24; 23; 22; 17]; [25; 22]; [26; 6; 2; 1];\n    [27; 5; 2; 1]; [28; 25]; [29; 27]; [30; 6; 4; 1]; [31; 28];\n    [32; 22; 2; 1]; [33; 20]; [34; 27; 2; 1]; [35; 33]; [36; 25];\n    [37; 5; 4; 3; 2; 1]; [38; 6; 5; 1]; [39; 35]; [40; 38; 21; 19]; [41; 38];\n    [42; 41; 20; 19]; [43; 42; 38; 37]; [44; 43; 18; 17]; [45; 44; 42; 41];\n    [46; 45; 26; 25]; [47; 42]; [48; 47; 21; 20]; [49; 40]; [50; 49; 24; 23];\n    [51; 50; 36; 35]; [52; 49]; [53; 52; 38; 37]; [54; 53; 18; 17]; [55; 31];\n    [56; 55; 35; 34]; [57; 50]; [58; 39]; [59; 58; 38; 37]; [60; 59];\n    [61; 60; 46; 45]; [62; 61; 6; 5]; [63; 62]; [64; 63; 61; 60]; [65; 47];\n    [66; 65; 57; 56]; [67; 66; 58; 57]; [68; 59]; [69; 67; 42; 40];\n    [70; 69; 55; 54]; [71; 65]; [72; 66; 25; 19]; [73; 48]; [74; 73; 59; 58];\n    [75; 74; 65; ...]; ...|]\n
","metadata":{}},{"output_type":"pyout","prompt_number":3,"html":"
val counterpart : int list -> int list = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Running the LFSR"},{"metadata":{},"input":"let rec run f n state = \n if n=0 then []\n else \n state :: run f (n-1) (f state)","cell_type":"code","prompt_number":4,"outputs":[{"output_type":"pyout","prompt_number":4,"html":"
val run : ('a -> 'a) -> int -> 'a -> 'a list = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"module B = Bits.Comb.IntbitsList\nmodule L = Lfsr(B)","cell_type":"code","prompt_number":5,"outputs":[{"output_type":"pyout","prompt_number":5,"html":"
module B = HardCaml.Bits.Comb.IntbitsList\n
","metadata":{}},{"output_type":"pyout","prompt_number":5,"html":"
module L :\n  sig\n    val galois : (B.t -> B.t -> B.t) -> int list -> B.t -> B.t\n    val fibonacci : (B.t -> B.t -> B.t) -> int list -> B.t -> B.t\n  end\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"run (L.galois B.(^:) taps.(4)) 16 (B.ones 4)","cell_type":"code","prompt_number":6,"outputs":[{"output_type":"pyout","prompt_number":6,"html":"
- : B.t list =\n[[1; 1; 1; 1]; [1; 0; 1; 1]; [1; 0; 0; 1]; [1; 0; 0; 0]; [0; 1; 0; 0];\n [0; 0; 1; 0]; [0; 0; 0; 1]; [1; 1; 0; 0]; [0; 1; 1; 0]; [0; 0; 1; 1];\n [1; 1; 0; 1]; [1; 0; 1; 0]; [0; 1; 0; 1]; [1; 1; 1; 0]; [0; 1; 1; 1];\n [1; 1; 1; 1]]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"run (L.fibonacci B.(^:) taps.(4)) 16 (B.ones 4)","cell_type":"code","prompt_number":7,"outputs":[{"output_type":"pyout","prompt_number":7,"html":"
- : B.t list =\n[[1; 1; 1; 1]; [1; 1; 1; 0]; [1; 1; 0; 0]; [1; 0; 0; 0]; [0; 0; 0; 1];\n [0; 0; 1; 0]; [0; 1; 0; 0]; [1; 0; 0; 1]; [0; 0; 1; 1]; [0; 1; 1; 0];\n [1; 1; 0; 1]; [1; 0; 1; 0]; [0; 1; 0; 1]; [1; 0; 1; 1]; [0; 1; 1; 1];\n [1; 1; 1; 1]]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let xnor a b = B.( ~: (a ^: b) )","cell_type":"code","prompt_number":8,"outputs":[{"output_type":"pyout","prompt_number":8,"html":"
val xnor : B.t -> B.t -> B.t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"run (L.galois xnor taps.(4)) 16 (B.zero 4)","cell_type":"code","prompt_number":9,"outputs":[{"output_type":"pyout","prompt_number":9,"html":"
- : B.t list =\n[[0; 0; 0; 0]; [0; 1; 0; 0]; [0; 1; 1; 0]; [0; 1; 1; 1]; [1; 0; 1; 1];\n [1; 1; 0; 1]; [1; 1; 1; 0]; [0; 0; 1; 1]; [1; 0; 0; 1]; [1; 1; 0; 0];\n [0; 0; 1; 0]; [0; 1; 0; 1]; [1; 0; 1; 0]; [0; 0; 0; 1]; [1; 0; 0; 0];\n [0; 0; 0; 0]]\n
","metadata":{}}],"language":"python","collapsed":false}],"metadata":{}}],"nbformat":3,"nbformat_minor":0} -------------------------------------------------------------------------------- /notebooks/50-chisel.ipynb: -------------------------------------------------------------------------------- 1 | {"metadata":{"name":"","language":"ocaml"},"worksheets":[{"cells":[{"metadata":{},"cell_type":"heading","source":"Chisel","level":1},{"metadata":{},"cell_type":"markdown","source":"Chisel is a recently released HDL similar to HardCaml based on Scala. To constrast and compare here are a few examples from the Chisel website converted to HardCaml."},{"metadata":{},"input":"open HardCaml\nopen Signal.Comb\nopen Signal.Seq\nopen Signal.Guarded","cell_type":"code","prompt_number":1,"outputs":[],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"GCD","level":2},{"metadata":{},"cell_type":"markdown","source":"```scala\nclass GCD extends Module {\n val io = new Bundle {\n val a = UInt(INPUT, 16)\n val b = UInt(INPUT, 16)\n val e = Bool(INPUT)\n val z = UInt(OUTPUT, 16)\n val v = Bool(OUTPUT)\n }\n val x = Reg(UInt())\n val y = Reg(UInt())\n when (x > y) { x := x - y }\n unless (x > y) { y := y - x }\n when (io.e) { x := io.a; y := io.b }\n io.z := x\n io.v := y === UInt(0)\n}\n```"},{"metadata":{},"input":"let gcd e a b = \n let bits = width a in\n let x, y = g_reg r_sync empty bits, g_reg r_sync empty bits in\n let () = compile [\n g_if (x#q >: y#q) \n [ x $== x#q -: y#q ]\n [ y $== y#q -: x#q ];\n g_when (e) [ x $== a; y $== b; ];\n ] in\n let z, v = x#q, y#q ==:. 0 in\n z, v","cell_type":"code","prompt_number":2,"outputs":[{"output_type":"pyout","prompt_number":2,"html":"
val gcd : t -> t -> t -> t * t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"MaxN","level":2},{"metadata":{},"cell_type":"markdown","source":"```scala\nclass MaxN(n: Int, w: Int /* parameterized input */) extends Module {\n\n private def Max2(x: UInt, y: UInt) = Mux(x > y, x, y)\n\n val io = new Bundle {\n val in = Vec.fill(n){ UInt(INPUT, w) }\n val out = UInt(OUTPUT, w)\n }\n io.out := io.in.reduceLeft(Max2)\n}\n```"},{"metadata":{},"input":"let maxn = reduce (fun x y -> mux2 (x >: y) x y)","cell_type":"code","prompt_number":3,"outputs":[{"output_type":"pyout","prompt_number":3,"html":"
val maxn : t list -> t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"Mul","level":2},{"metadata":{},"cell_type":"markdown","source":"```scala\nclass Mul extends Module {\n val io = new Bundle {\n val x = UInt(INPUT, 4)\n val y = UInt(INPUT, 4)\n val z = UInt(OUTPUT, 8)\n }\n val muls = new ArrayBuffer[UInt]()\n\n for (i <- 0 until 16)\n for (j <- 0 until 16)\n muls += UInt(i * j, width = 8)\n val tbl = Vec(muls)\n io.z := tbl((io.x << UInt(4)) | io.y)\n}\n```"},{"metadata":{},"input":"let rom_of_binop f a b = \n let wa, wb = width a, width b in\n let na, nb = 1 lsl wa, 1 lsl wb in\n let r = Array.init na (fun ia -> Array.init nb (fun ib -> f (consti wa ia) (consti wb ib))) in\n r |> Array.map Array.to_list |> Array.to_list |> List.concat |> mux (a @: b)\n \nlet mulu_rom = rom_of_binop ( *: )","cell_type":"code","prompt_number":4,"outputs":[{"output_type":"pyout","prompt_number":4,"html":"
val rom_of_binop : (t -> t -> t) -> t -> t -> t = <fun>\n
","metadata":{}},{"output_type":"pyout","prompt_number":4,"html":"
val mulu_rom : t -> t -> t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"Adder","level":2},{"metadata":{},"cell_type":"markdown","source":"```scala\nclass Adder(val n:Int) extends Module {\n val io = new Bundle {\n val A = UInt(INPUT, n)\n val B = UInt(INPUT, n)\n val Cin = UInt(INPUT, 1)\n val Sum = UInt(OUTPUT, n)\n val Cout = UInt(OUTPUT, 1)\n }\n //create a vector of FullAdders\n val FAs = Vec.fill(n){ Module(new FullAdder()).io }\n val carry = Vec.fill(n+1){ UInt(width = 1) }\n val sum = Vec.fill(n){ Bool() }\n\n //first carry is the top level carry in\n carry(0) := io.Cin\n\n //wire up the ports of the full adders\n for (i <- 0 until n) {\n FAs(i).a := io.A(i)\n FAs(i).b := io.B(i)\n FAs(i).cin := carry(i)\n carry(i+1) := FAs(i).cout\n sum(i) := FAs(i).sum.toBool()\n }\n io.Sum := sum.toBits().toUInt()\n io.Cout := carry(n)\n}\n```"},{"metadata":{},"input":"(* single bit full adder *)\nlet fa c_in x y = \n let sum = (x ^: y) ^: c_in in\n let c_out = (x &: y) |: (x &: c_in) |: (y &: c_in) in\n sum, c_out\n\n(* ripple carry adder *)\nlet adder c_in x y = \n let fa (result, c_in) x y = \n let sum, c_out = fa c_in x y in\n (sum::result), c_out\n in\n let result, carry = List.fold_left2 fa ([], c_in)\n (List.rev (bits x)) (List.rev (bits y))\n in\n carry @: (result |> concat)","cell_type":"code","prompt_number":5,"outputs":[{"output_type":"pyout","prompt_number":5,"html":"
val fa : t -> t -> t -> t * t = <fun>\n
","metadata":{}},{"output_type":"pyout","prompt_number":5,"html":"
val adder : t -> t -> t -> t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false}],"metadata":{}}],"nbformat":3,"nbformat_minor":0} -------------------------------------------------------------------------------- /src/api.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (* Pre-build functors *) 12 | 13 | module type S = sig 14 | module B : Comb.S 15 | module Cyclesim : module type of Cyclesim.Make(B) 16 | module Cosim : module type of Cosim.Make(B) 17 | module Gtkwave : module type of Vcd.Gtkwave(B) 18 | module Vcd : module type of Vcd.Make(B) 19 | module Interface : sig 20 | module Gen : module type of Interface.Gen(B) 21 | module Gen_cosim : module type of Interface.Gen_cosim(B) 22 | module Sim : module type of Interface.Sim(B) 23 | end 24 | type bits = B.t 25 | type signal = Signal.Comb.t 26 | end 27 | 28 | module Make(Bits : Comb.S) = struct 29 | 30 | module B = Bits 31 | 32 | module Cyclesim = Cyclesim.Make(Bits) 33 | module Cosim = Cosim.Make(Bits) 34 | 35 | module Gtkwave = Vcd.Gtkwave(Bits) 36 | module Vcd = Vcd.Make(Bits) 37 | 38 | module Interface = struct 39 | module Gen = Interface.Gen(Bits) 40 | module Gen_cosim = Interface.Gen_cosim(Bits) 41 | module Sim = Interface.Sim(Bits) 42 | end 43 | 44 | type bits = B.t 45 | type signal = Signal.Comb.t 46 | end 47 | 48 | module Comb = Signal.Comb 49 | module Seq = Signal.Seq 50 | module Cs = Cyclesim.Api 51 | 52 | include Make(Bits.Comb.IntbitsList) 53 | 54 | -------------------------------------------------------------------------------- /src/api.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Pre-built API functors *) 12 | module type S = sig 13 | module B : Comb.S 14 | module Cyclesim : module type of Cyclesim.Make(B) 15 | module Cosim : module type of Cosim.Make(B) 16 | module Gtkwave : module type of Vcd.Gtkwave(B) 17 | module Vcd : module type of Vcd.Make(B) 18 | module Interface : sig 19 | module Gen : module type of Interface.Gen(B) 20 | module Gen_cosim : module type of Interface.Gen_cosim(B) 21 | module Sim : module type of Interface.Sim(B) 22 | end 23 | type bits = B.t 24 | type signal = Signal.Comb.t 25 | end 26 | 27 | module Make(Bits : Comb.S) : S 28 | with type B.t = Bits.t 29 | and type signal = Signal.Comb.t 30 | 31 | module Comb : module type of Signal.Comb 32 | module Seq : module type of Signal.Seq 33 | module Cs : module type of Cyclesim.Api 34 | with type 'a cyclesim = 'a Cyclesim.Api.cyclesim 35 | 36 | include module type of Make(Bits.Comb.IntbitsList) 37 | -------------------------------------------------------------------------------- /src/bits.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Modules which implement {!modtype: Comb.S} as directly usable data-structures *) 12 | 13 | (* exported to build the bigarray types in Bits_ext *) 14 | module type ArraybitsBase = 15 | sig 16 | 17 | type elt (* type of elements *) 18 | type barray (* type of array *) 19 | 20 | val nbits : int (* bit size of elements *) 21 | val words : int -> int 22 | val word : int -> int 23 | val create : int -> barray (* create array *) 24 | val mask : int -> elt (* create mask *) 25 | val mask_bit : int -> elt 26 | 27 | val to_bits : string -> barray 28 | val to_bstr : int -> barray -> string 29 | val to_int : barray -> int 30 | val of_int : int -> int -> barray 31 | 32 | val zero : elt 33 | val one : elt 34 | 35 | val get : barray -> int -> elt 36 | val set : barray -> int -> elt -> unit 37 | 38 | (* operations on elements *) 39 | val (+.) : elt -> elt -> elt 40 | val (-.) : elt -> elt -> elt 41 | val (&.) : elt -> elt -> elt 42 | val (|.) : elt -> elt -> elt 43 | val (^.) : elt -> elt -> elt 44 | val (~.) : elt -> elt 45 | val (>>.) : elt -> int -> elt 46 | val (<<.) : elt -> int -> elt 47 | 48 | end 49 | 50 | module ArraybitsInt32Api : ArraybitsBase 51 | module ArraybitsInt64Api : ArraybitsBase 52 | module ArraybitsNativeintApi : ArraybitsBase 53 | 54 | module ArraybitsBuilder(B : ArraybitsBase) : (Comb.T with type t = B.barray * int) 55 | 56 | module Ext : sig 57 | 58 | (* bit's API's with conversions *) 59 | 60 | module Utils_ext : 61 | sig 62 | type ba32 = (int32, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array1.t 63 | type ba64 = (int64, Bigarray.int64_elt, Bigarray.c_layout) Bigarray.Array1.t 64 | type bani = (nativeint, Bigarray.nativeint_elt, Bigarray.c_layout) Bigarray.Array1.t 65 | 66 | (** converts a big_int to a binary string *) 67 | val bstr_of_big_int : int -> Big_int.big_int -> string 68 | 69 | (** converts a binary string to a big int *) 70 | val big_int_of_bstr : string -> Big_int.big_int 71 | 72 | (** binary Big_int.big_int to array of int32 *) 73 | val abits_int32_of_big_int : int -> Big_int.big_int -> int32 array 74 | 75 | (** array of int32 to binary Big_int.big_int *) 76 | val big_int_of_abits_int32 : int32 array -> Big_int.big_int 77 | 78 | (** binary Big_int.big_int to array of int32 *) 79 | val abits_int64_of_big_int : int -> Big_int.big_int -> int64 array 80 | 81 | (** array of int32 to binary Big_int.big_int *) 82 | val big_int_of_abits_int64 : int64 array -> Big_int.big_int 83 | 84 | (** binary Big_int.big_int to array of int32 *) 85 | val abits_nint_of_big_int : int -> Big_int.big_int -> nativeint array 86 | 87 | (** array of int32 to binary Big_int.big_int *) 88 | val big_int_of_abits_nint : nativeint array -> Big_int.big_int 89 | 90 | (** binary Big_int.big_int to big array of int32 *) 91 | val babits_int32_of_big_int : int -> Big_int.big_int -> ba32 92 | 93 | (** big array of int32 to binary Big_int.big_int *) 94 | val big_int_of_babits_int32 : ba32 -> Big_int.big_int 95 | 96 | (** binary Big_int.big_int to big array of int64 *) 97 | val babits_int64_of_big_int : int -> Big_int.big_int -> ba64 98 | 99 | (** big array of int64 to binary Big_int.big_int *) 100 | val big_int_of_babits_int64 : ba64 -> Big_int.big_int 101 | 102 | (** binary Big_int.big_int to big array of nativeint *) 103 | val babits_nint_of_big_int : int -> Big_int.big_int -> bani 104 | 105 | (** big array of native int to binary Big_int.big_int *) 106 | val big_int_of_babits_nint : bani -> Big_int.big_int 107 | 108 | (** binary string to big array of int32 *) 109 | val babits_int32_of_bstr : string -> ba32 110 | 111 | (** big array of int32 to binary string *) 112 | val bstr_of_babits_int32 : int -> ba32 -> string 113 | 114 | (** binary string to big array of int64 *) 115 | val babits_int64_of_bstr : string -> ba64 116 | 117 | (** big array of int64 to binary string *) 118 | val bstr_of_babits_int64 : int -> ba64 -> string 119 | 120 | (** binary string to big array of nativeint *) 121 | val babits_nint_of_bstr : string -> bani 122 | 123 | (** big array of native int to binary string *) 124 | val bstr_of_babits_nint : int -> bani -> string 125 | 126 | end 127 | 128 | module BigarraybitsInt32_Bits : (Comb.S with type t = Utils_ext.ba32 * int) 129 | module BigarraybitsInt64_Bits : (Comb.S with type t = Utils_ext.ba64 * int) 130 | module BigarraybitsNativeint_Bits : (Comb.S with type t = Utils_ext.bani * int) 131 | 132 | module Comb : 133 | sig 134 | 135 | module type T = 136 | sig 137 | include Comb.S 138 | 139 | (** is the data type mutable *) 140 | val is_mutable : bool 141 | 142 | (** create nativeint based big array from signal (if possible) - mutates input *) 143 | val to_bani_ptr : t -> Utils_ext.bani -> unit 144 | 145 | (** create signal from nativeint based big array - mutates input *) 146 | val of_bani_ptr : int -> Utils_ext.bani -> t -> t 147 | 148 | (** convert to Big_int *) 149 | val to_bigint : t -> Big_int.big_int 150 | 151 | (** convert from Big_int *) 152 | val of_bigint : int -> Big_int.big_int -> t 153 | 154 | end 155 | 156 | module type S = 157 | sig 158 | 159 | include Comb.S 160 | 161 | (** is the data type mutable *) 162 | val is_mutable : bool 163 | 164 | (** create nativeint based big array from signal (if possible) - mutates input *) 165 | val to_bani_ptr : t -> Utils_ext.bani -> unit 166 | 167 | (** create signal from nativeint based big array - mutates input *) 168 | val of_bani_ptr : int -> Utils_ext.bani -> t -> t 169 | 170 | (** create nativeint based big array from signal (if possible) *) 171 | val to_bani : t -> Utils_ext.bani 172 | 173 | (** create signal from nativeint based big array *) 174 | val of_bani : int -> Utils_ext.bani -> t 175 | 176 | (** convert to Big_int *) 177 | val to_bigint : t -> Big_int.big_int 178 | 179 | (** convert from Big_int *) 180 | val of_bigint : int -> Big_int.big_int -> t 181 | 182 | end 183 | 184 | (** Generates the API with conversion functions *) 185 | module MakeC(Conv : T) : (S with type t = Conv.t) 186 | 187 | module IntbitsList : (S with type t = int list) 188 | 189 | module Intbits : (S with type t = int*int) 190 | module Int32bits : (S with type t = int32*int) 191 | module Int64bits : (S with type t = int64*int) 192 | module Nativeintbits : (S with type t = nativeint*int) 193 | 194 | module ArraybitsInt32 : (S with type t = int32 array * int) 195 | module ArraybitsInt64 : (S with type t = int64 array * int) 196 | module ArraybitsNativeint : (S with type t = nativeint array * int) 197 | 198 | module BigarraybitsInt32 : (S with type t = Utils_ext.ba32 * int) 199 | module BigarraybitsInt64 : (S with type t = Utils_ext.ba64 * int) 200 | module BigarraybitsNativeint : (S with type t = Utils_ext.bani * int) 201 | end 202 | 203 | end 204 | 205 | module Raw : sig 206 | 207 | module type S = sig 208 | 209 | type t 210 | 211 | val empty : t 212 | val width : t -> int 213 | 214 | val to_string : t -> string 215 | val to_int : t -> int 216 | val to_bstr : t -> string 217 | 218 | val create : int -> t 219 | val copy : t -> t -> unit 220 | 221 | val const : string -> t 222 | val vdd : t 223 | val gnd : t 224 | 225 | val wire : int -> t 226 | val (--) : t -> string -> t 227 | 228 | val (&:) : t -> t -> t -> unit 229 | val (|:) : t -> t -> t -> unit 230 | val (^:) : t -> t -> t -> unit 231 | 232 | val (~:) : t -> t -> unit 233 | 234 | val (+:) : t -> t -> t -> unit 235 | val (-:) : t -> t -> t -> unit 236 | 237 | val (==:) : t -> t -> t -> unit 238 | val (<>:) : t -> t -> t -> unit 239 | val (<:) : t -> t -> t -> unit 240 | 241 | val mux : t -> t -> t list -> unit 242 | 243 | val concat : t -> t list -> unit 244 | val select : t -> t -> int -> int -> unit 245 | 246 | val ( *: ) : t -> t -> t -> unit 247 | val ( *+ ) : t -> t -> t -> unit 248 | 249 | end 250 | 251 | module Build(B : ArraybitsBase) : (S with type t = B.barray * int) 252 | 253 | (** mutable bits described using array of int32 *) 254 | module ArraybitsInt32 : (S with type t = int32 array * int) 255 | 256 | (** mutable bits described using array of int64 *) 257 | module ArraybitsInt64 : (S with type t = int64 array * int) 258 | 259 | (** mutable bits described using array of nativeint *) 260 | module ArraybitsNativeint : (S with type t = nativeint array * int) 261 | 262 | module Comb : sig 263 | 264 | (** bits described using array of int32 *) 265 | module ArraybitsInt32 : (Comb.S with type t = int32 array * int) 266 | 267 | (** bits described using array of int64 *) 268 | module ArraybitsInt64 : (Comb.S with type t = int64 array * int) 269 | 270 | (** bits described using array of nativeint *) 271 | module ArraybitsNativeint : (Comb.S with type t = nativeint array * int) 272 | 273 | end 274 | 275 | end 276 | 277 | (** Implemented API's *) 278 | module Comb : 279 | sig 280 | 281 | (** bits described as lists of ints ie [0;1;1;1;0] - width implicit as length of list*) 282 | module IntbitsList : (Comb.S with type t = int list) 283 | 284 | (** bits described with ocamls ints and a width (<=31) *) 285 | module Intbits : (Comb.S with type t = int*int) 286 | 287 | (** bits described using int32 and a width (<=32) *) 288 | module Int32bits : (Comb.S with type t = int32*int) 289 | 290 | (** bits described using int64 and a width (<=64) *) 291 | module Int64bits : (Comb.S with type t = int64*int) 292 | 293 | (** bits described using nativeint and a width (max size platform dependant) *) 294 | module Nativeintbits : (Comb.S with type t = nativeint*int) 295 | 296 | (** bits described using array of int32 *) 297 | module ArraybitsInt32 : (Comb.S with type t = int32 array * int) 298 | 299 | (** bits described using array of int64 *) 300 | module ArraybitsInt64 : (Comb.S with type t = int64 array * int) 301 | 302 | (** bits described using array of nativeint *) 303 | module ArraybitsNativeint : (Comb.S with type t = nativeint array * int) 304 | 305 | end 306 | 307 | -------------------------------------------------------------------------------- /src/circuit.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Creation and manipulation of hardware circuits *) 12 | 13 | exception Failure of string 14 | 15 | (** Generation of valid netlist names from signal names *) 16 | module Mangler : 17 | sig 18 | 19 | (** a name mangler is a mapping from strings to the next available integer which should be added to the name to make it unique *) 20 | type t = (string, int) Hashtbl.t 21 | 22 | (** create a new name mangler *) 23 | val make : string list -> t 24 | 25 | (** lookup the string in the mangler hash table to see if it exists. If it does 26 | not, -1 is returned. Otherwise the next available index is returned. Note; 27 | it is possible that a name constructed with this index already exists! *) 28 | val lookup : t -> string -> int 29 | 30 | (** adds a name to the mangler, assuming it doesnt exist already - raises an exception if it does *) 31 | val addfresh : t -> string -> unit 32 | 33 | (** returns a mangled name from the given string. Note; mangled strings are also 34 | added to cope with the likes of the following sequence; 35 | - mangle "hello" -> "hello" 36 | - mangle "hello" -> "hello_0" 37 | - mangle "hello_0" -> "hello_0_0" *) 38 | val mangle : t -> string -> string 39 | 40 | end 41 | 42 | (** circuit data structure *) 43 | type t = 44 | { 45 | circ_name : string; (** circuit name *) 46 | circ_id_to_sig : Signal.Types.signal Signal.Types.UidMap.t; (** map id's to signals *) 47 | circ_inputs : Signal.Types.signal list; (** circuit inputs *) 48 | circ_outputs : Signal.Types.signal list; (** circuit outputs *) 49 | circ_fanout : Signal.Types.UidSet.t Signal.Types.UidMap.t; (** fanout's of each signal *) 50 | circ_fanin : Signal.Types.UidSet.t Signal.Types.UidMap.t; (** fanin's of each signal *) 51 | } 52 | 53 | (** create circuit data structure *) 54 | val make : string -> Signal.Types.signal list -> t 55 | 56 | (** null search function *) 57 | val id : ('a -> Signal.Types.signal -> 'a) 58 | 59 | (** search circuit starting at given signal *) 60 | val search1 : ('a -> Signal.Types.signal -> 'a) -> ('a -> Signal.Types.signal -> 'a) -> 'a -> Signal.Types.signal -> 'a 61 | 62 | (** search circuit from each given signal *) 63 | val search : ('a -> Signal.Types.signal -> 'a) -> ('a -> Signal.Types.signal -> 'a) -> 'a -> Signal.Types.signal list -> 'a 64 | 65 | (** create a set of UID's from each given signal *) 66 | val set_of_signals : Signal.Types.signal list -> Signal.Types.UidSet.t 67 | 68 | (** filter on signals *) 69 | val filter : (Signal.Types.signal -> bool) -> Signal.Types.signal list -> Signal.Types.signal list 70 | 71 | (** return circuit inputs *) 72 | val inputs : t -> Signal.Types.signal list 73 | 74 | (** return circuit outputs *) 75 | val outputs : t -> Signal.Types.signal list 76 | 77 | (** return circuit name *) 78 | val name : t -> string 79 | 80 | (** create a map of signal uids to mangled names *) 81 | val mangle_names : string list -> string -> t -> (Signal.Types.uid -> int -> string) 82 | 83 | (** is the signal an input to the circuit *) 84 | val is_input : t -> Signal.Types.signal -> bool 85 | 86 | (** is the signal an output of the circuit *) 87 | val is_output : t -> Signal.Types.signal -> bool 88 | 89 | val signal_of_uid : t -> Signal.Types.uid -> Signal.Types.signal 90 | 91 | val signal_map : t -> Signal.Types.signal Signal.Types.UidMap.t 92 | 93 | (** construct a set of fanouts from nodes *) 94 | val find_fanout : (Signal.Types.signal -> Signal.Types.signal list) -> 95 | Signal.Types.signal list -> 96 | Signal.Types.UidSet.t Signal.Types.UidMap.t 97 | 98 | val find_signals : (Signal.Types.signal -> bool) -> Signal.Types.signal list -> 99 | Signal.Types.signal list 100 | 101 | (** find all signals which match the given name *) 102 | val find_signals_by_name : string -> Signal.Types.signal list -> 103 | Signal.Types.signal list 104 | 105 | (** compare 2 circuits to see if they are the same *) 106 | val structural_compare : ?check_names:bool -> t -> t -> bool 107 | 108 | (* 109 | module Plugin : 110 | sig 111 | 112 | type param_elt = 113 | | Int of int 114 | | String of string 115 | | Float of float 116 | | Bool of bool 117 | | List of param_elt list 118 | type param = string * param_elt 119 | 120 | val get_int : param_elt -> int 121 | val get_string : param_elt -> string 122 | val get_float : param_elt -> float 123 | val get_bool : param_elt -> bool 124 | val get_list : param_elt -> param_elt list 125 | 126 | type input = string * int 127 | type get_inputs = param list -> input list 128 | type get_circuit = param list -> 129 | (string * Signal.Types.signal) list -> 130 | t 131 | 132 | val load : string -> 133 | (param list -> param list) -> 134 | (input list -> input list) -> 135 | t list 136 | 137 | val register : 138 | (param list * get_inputs * get_circuit) list -> unit 139 | 140 | end 141 | *) 142 | 143 | module Hierarchy : 144 | sig 145 | 146 | type database 147 | val empty : unit -> database 148 | 149 | (* take a circuit, and return a (mangled) name for it *) 150 | val add : ?check_names:bool -> database -> t -> string 151 | 152 | (* return the circuit matching the (mangled) name *) 153 | val get : database -> string -> t option 154 | 155 | end 156 | 157 | -------------------------------------------------------------------------------- /src/cosim.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open Astring 12 | 13 | type delta_message = 14 | { 15 | sets : (string * string) list; 16 | gets : string list; 17 | delta_time : int64; 18 | } 19 | 20 | type init_message = string list 21 | 22 | type control_message = 23 | | Finish 24 | | Run of delta_message 25 | 26 | type response_message = (string * string) list 27 | 28 | let net_addr = "localhost" 29 | let net_port = 10101 30 | 31 | module Comms = struct 32 | 33 | open Unix 34 | 35 | let empty = "" 36 | 37 | let create_client server port = 38 | let sock = socket PF_INET SOCK_STREAM 0 in 39 | let server_addr = ADDR_INET( (gethostbyname server).h_addr_list.(0), port ) in 40 | let () = connect sock server_addr in 41 | sock 42 | 43 | let create_server client port = 44 | let sock = socket PF_INET SOCK_STREAM 0 in 45 | let () = setsockopt sock SO_REUSEADDR true in 46 | let client_addr = ADDR_INET( (gethostbyname client).h_addr_list.(0), port ) in 47 | let () = bind sock client_addr in 48 | let () = listen sock 1 in 49 | sock 50 | 51 | let accept_client sock = fst (accept sock) 52 | 53 | (* send value stored in byte buffer *) 54 | let send sock bytes = write sock (Bytes.of_string bytes) 0 (String.length bytes) 55 | 56 | (* recv marshalled value to a buffer *) 57 | let recv sock = 58 | let header = Bytes.create Marshal.header_size in 59 | let () = 60 | if Marshal.header_size <> read sock header 0 Marshal.header_size then 61 | failwith "recv_marshalled Marshal.header_size" 62 | in 63 | let data_size = Marshal.data_size header 0 in 64 | let data = Bytes.create data_size in 65 | let () = 66 | if data_size <> read sock data 0 data_size then 67 | failwith "recv_marshalled Marshal.data_size" 68 | in 69 | String.concat ~sep:empty [ Bytes.to_string header; Bytes.to_string data ] 70 | 71 | let send_string socket str = send socket (Marshal.to_string str []) 72 | let recv_string socket = (Marshal.from_string (recv socket) 0 : string) 73 | let recv_string_is socket expected = 74 | let got = recv_string socket in 75 | if got <> expected then 76 | failwith ("recv_string_is expected '" ^ expected ^ "' got '" ^ got ^ "'") 77 | 78 | end 79 | 80 | let control server message = 81 | let _ = Comms.send server (Marshal.to_string message []) in 82 | match message with 83 | | Finish -> [] 84 | | Run ({ gets; }) when gets=[] -> [] 85 | | _ -> (Marshal.from_string (Comms.recv server) 0 : response_message) 86 | 87 | let testbench_name name = name ^ "_hardcaml_testbench" 88 | let instance_name name = "the_hardcaml_" ^ name 89 | 90 | let write_testbench ?dump_file ~name ~inputs ~outputs os = 91 | 92 | let declare net s = 93 | let width = snd s in 94 | os (" " ^ net ^ " "); 95 | if width > 1 then begin 96 | os "["; os (string_of_int (width - 1)); os ":0] " 97 | end; 98 | os (fst s); 99 | os ";\n" 100 | in 101 | 102 | os ("module " ^ name ^ "_hardcaml_testbench;\n"); 103 | List.iter (declare "reg") inputs; 104 | List.iter (declare "wire") outputs; 105 | begin 106 | match dump_file with 107 | | Some(dump_file) -> begin 108 | os " initial begin\n"; 109 | os (" $dumpfile(\"" ^ dump_file ^ "\");\n"); 110 | os (" $dumpvars(0, " ^ instance_name name ^ ");\n"); 111 | os " end\n"; 112 | end 113 | | None -> () 114 | end; 115 | os (" " ^ name ^ " " ^ instance_name name ^ " ("); 116 | let ports = List.map (fun s -> "." ^ fst s ^ "(" ^ fst s ^ ")") (inputs @ outputs) in 117 | os (String.concat ~sep:", " ports); 118 | os ");\n"; 119 | os "endmodule" 120 | 121 | let write_testbench_from_circuit ?dump_file os circuit = 122 | let open Signal.Types in 123 | let cname = Circuit.name circuit in 124 | let name s = List.hd (Signal.Types.names s) in 125 | let inputs = List.map (fun s -> name s, width s) (Circuit.inputs circuit) in 126 | let outputs = List.map (fun s -> name s, width s) (Circuit.outputs circuit) in 127 | write_testbench ?dump_file ~name:cname ~inputs ~outputs os 128 | 129 | let compile verilog vvp = 130 | match Unix.system ("iverilog -o " ^ vvp ^ " " ^ (String.concat ~sep:" " verilog)) with 131 | | Unix.WEXITED(0) -> () 132 | | _ -> failwith ("Failed to compile verilog to vvp") 133 | 134 | let derive_clocks_and_resets circuit = 135 | let open Signal.Types in 136 | let seq_elts = Circuit.find_signals (fun s -> is_reg s || is_mem s) (Circuit.outputs circuit) in 137 | let clocks_and_resets = 138 | List.map (function 139 | | Signal_reg(_,r) -> r.reg_clock, r.reg_reset 140 | | Signal_mem(_,_,r,_) -> r.reg_clock, r.reg_reset 141 | | _ -> failwith "unexpected") seq_elts 142 | in 143 | let module SSet = Set.Make(struct type t = string let compare = compare end) in 144 | let unique_names l = 145 | SSet.elements 146 | (List.fold_left 147 | (fun set s -> 148 | try SSet.add (List.hd (names s)) set 149 | with _ -> set) 150 | SSet.empty l) 151 | in 152 | unique_names (List.map fst clocks_and_resets), 153 | unique_names (List.map snd clocks_and_resets) 154 | 155 | let load_sim vvp_file = 156 | let command = "`opam config var bin`/hardcaml_vvp.sh " ^ vvp_file in 157 | let _ = Unix.open_process_out command in 158 | () 159 | 160 | let compile_and_load_sim ?dump_file circuit = 161 | let verilog_file_name = Filename.temp_file "hardcaml_cosim_" "_verilog" in 162 | let vvp_file_name = Filename.temp_file "hardcaml_cosim_" "_vvp" in 163 | let () = at_exit (fun _ -> Unix.unlink verilog_file_name; Unix.unlink vvp_file_name) in 164 | (* write RTL and testbench *) 165 | let verilog_file = open_out verilog_file_name in 166 | let () = Rtl.Verilog.write (output_string verilog_file) circuit in 167 | let () = write_testbench_from_circuit ?dump_file (output_string verilog_file) circuit in 168 | let () = close_out verilog_file in 169 | (* compile *) 170 | let () = compile [verilog_file_name] vvp_file_name in 171 | (* load simulation *) 172 | load_sim vvp_file_name 173 | 174 | module Make(B : Comb.S) = struct 175 | 176 | let is_legal_char c = c = '1' || c = '0' 177 | 178 | let rec is_legal s i = 179 | try 180 | if is_legal_char s.[i] then is_legal s (i+1) 181 | else false 182 | with _ -> 183 | true 184 | 185 | let legalise_value s = 186 | if is_legal s 0 then s 187 | else String.map (fun c -> if is_legal_char c then c else '0') s 188 | 189 | let init_sim start_sim inputs outputs = 190 | (* create server *) 191 | let server = Comms.create_server net_addr net_port in 192 | let _ = at_exit (fun _ -> Unix.close server) in 193 | 194 | (* start simulator *) 195 | let () = start_sim () in 196 | 197 | (* wait for connection *) 198 | let server = Comms.accept_client server in 199 | 200 | (* say hello *) 201 | let () = Comms.recv_string_is server "hello hardcaml" in 202 | let _ = Comms.send server (Marshal.to_string (List.map fst (inputs@outputs)) []) in 203 | 204 | (* set all input ports to zero *) 205 | let _ = control server 206 | (Run { sets = List.map (fun (n,w) -> n, B.to_bstr (B.zero w)) inputs; 207 | gets = []; delta_time = 0L }) 208 | in 209 | 210 | server 211 | 212 | let make_sim_obj ~server ~clocks ~resets ~inputs ~outputs = 213 | 214 | let inputs = List.map (fun (n,b) -> n, ref (B.zero b)) inputs in 215 | let outputs = List.map (fun (n,b) -> n, ref (B.zero b)) outputs in 216 | 217 | (* clock cycle update *) 218 | let clocks_1 = List.map (fun (n,_) -> n,"1") clocks in 219 | let clocks_0 = List.map (fun (n,_) -> n,"0") clocks in 220 | let get_outputs = List.map (fun (n,v) -> n) outputs in 221 | let fcycle () = 222 | let set_inputs = List.map (fun (n,v) -> n, B.to_bstr !v) inputs in 223 | let _ = control server 224 | (Run { sets = clocks_1; gets = []; delta_time = 0L; }) 225 | in 226 | let _ = control server 227 | (Run { sets = set_inputs; gets = []; delta_time = 5L; }) 228 | in 229 | let res = control server 230 | (Run { sets = clocks_0; gets = get_outputs; delta_time = 5L; }) 231 | in 232 | List.iter2 233 | (fun (n,v) (n',v') -> assert (n = n'); v := B.const (legalise_value v')) 234 | outputs res 235 | in 236 | 237 | (* reset update *) 238 | let resets_1 = List.map (fun (n,_) -> n,"1") resets in 239 | let resets_0 = List.map (fun (n,_) -> n,"0") resets in 240 | let freset () = 241 | let _ = control server 242 | (Run { sets = resets_1; gets = []; delta_time = 10L; }) 243 | in 244 | let _ = control server 245 | (Run { sets = resets_0; gets = []; delta_time = 0L; }) 246 | in 247 | () 248 | in 249 | 250 | (* simulation object *) 251 | Cyclesim.Api.({ 252 | sim_in_ports = inputs; 253 | sim_out_ports = outputs; 254 | sim_out_ports_next = outputs; 255 | sim_internal_ports = []; 256 | sim_reset = freset; 257 | sim_cycle_check = (fun () -> ()); 258 | sim_cycle_comb0 = fcycle; (* XXX SPLIT ME UP, and this thing might work properly! XXX *) 259 | sim_cycle_seq = (fun () -> ()); 260 | sim_cycle_comb1 = (fun () -> ()); 261 | sim_lookup_signal = (fun uid -> failwith "sim_lookup_signal not implemented"); 262 | sim_lookup_reg = (fun uid -> failwith "sim_lookup_reg not implemented"); 263 | sim_lookup_memory = (fun uid -> failwith "sim_lookup_memory not implemented"); 264 | }) 265 | 266 | (* create simulator from hardcaml circuit *) 267 | let make ?dump_file circuit = 268 | let open Signal.Types in 269 | 270 | (* query circuit for ports *) 271 | let port_name s = 272 | match names s with 273 | | [n] -> n 274 | | _ -> failwith "not a port_name" 275 | in 276 | let get_port s = port_name s, width s in 277 | let inputs = List.map get_port (Circuit.inputs circuit) in 278 | let outputs = List.map get_port (Circuit.outputs circuit) in 279 | 280 | (* initialize server and simulation *) 281 | let server = init_sim (fun () -> compile_and_load_sim ?dump_file circuit) inputs outputs in 282 | 283 | (* create simulation object *) 284 | let clocks, resets = derive_clocks_and_resets circuit in 285 | 286 | (* remove clocks and resets from input ports *) 287 | let inputs = 288 | let cr = clocks @ resets in 289 | (* inputs without clocks and resets *) 290 | List.filter (fun (n,_) -> not (List.mem n cr)) inputs 291 | in 292 | 293 | let clocks, resets = List.map (fun n -> n,1) clocks, List.map (fun n -> n,1) resets in 294 | make_sim_obj ~server ~clocks ~resets ~inputs ~outputs 295 | 296 | let load ~clocks ~resets ~inputs ~outputs vvp_file = 297 | (* initialize server and simulation *) 298 | let server = init_sim (fun () -> load_sim vvp_file) (clocks@resets@inputs) outputs in 299 | 300 | (* create simulation object *) 301 | make_sim_obj ~server ~clocks ~resets ~inputs ~outputs 302 | 303 | end 304 | 305 | -------------------------------------------------------------------------------- /src/cosim.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Icarus Verilog Cosimulation interface *) 12 | 13 | (** run [sets], then [gets] then schedule next callback at cur_time+[delta_time]*) 14 | type delta_message = 15 | { 16 | sets : (string * string) list; 17 | gets : string list; 18 | delta_time : int64; 19 | } 20 | 21 | (** expected inputs and outputs *) 22 | type init_message = string list 23 | 24 | (** control message *) 25 | type control_message = 26 | | Finish 27 | | Run of delta_message 28 | 29 | (** response message *) 30 | type response_message = (string * string) list 31 | 32 | (* XXX to parameterise *) 33 | val net_addr : string 34 | val net_port : int 35 | 36 | (** basic TCP communications between client (simulation) and server (hardcaml) *) 37 | module Comms : sig 38 | open Unix 39 | val create_client : string -> int -> file_descr 40 | val create_server : string -> int -> file_descr 41 | val accept_client : file_descr -> file_descr 42 | val send : file_descr -> string -> int 43 | val recv : file_descr -> string 44 | 45 | val send_string : file_descr -> string -> int 46 | val recv_string : file_descr -> string 47 | val recv_string_is : file_descr -> string -> unit 48 | end 49 | 50 | (** send a control message to the simulation *) 51 | val control : Unix.file_descr -> control_message -> response_message 52 | 53 | (** write test harness *) 54 | val write_testbench : ?dump_file:string -> 55 | name:string -> inputs:(string*int) list -> outputs:(string*int) list -> 56 | (string -> unit) -> unit 57 | 58 | (** write test hardness derivied from a hardcaml circuit *) 59 | val write_testbench_from_circuit : ?dump_file:string -> (string -> unit) -> Circuit.t -> unit 60 | 61 | (** compile verilog files to a vvp simulation object *) 62 | val compile : string list -> string -> unit 63 | 64 | (** find clocks and resets in a hardcaml circuit *) 65 | val derive_clocks_and_resets : Circuit.t -> string list * string list 66 | 67 | (** load vvp file into simulator along with vpi object *) 68 | val load_sim : string -> unit 69 | 70 | (** compile circuit and load simulation *) 71 | val compile_and_load_sim : ?dump_file:string -> Circuit.t -> unit 72 | 73 | module Make(B : Comb.S) : sig 74 | 75 | val init_sim : (unit -> unit) -> (string * int) list -> (string * int) list -> Unix.file_descr 76 | 77 | val make_sim_obj : 78 | server:Unix.file_descr -> 79 | clocks:(string * int) list -> resets:(string * int) list -> 80 | inputs:(string * int) list -> outputs:(string * int) list -> 81 | B.t Cyclesim.Api.cyclesim 82 | 83 | (** create simulator from hardcaml circuit *) 84 | val make : ?dump_file:string -> Circuit.t -> B.t Cyclesim.Api.cyclesim 85 | 86 | (** load icarus vvp simulation *) 87 | val load : 88 | clocks:(string * int) list -> resets:(string * int) list -> 89 | inputs:(string * int) list -> outputs:(string * int) list -> 90 | string -> B.t Cyclesim.Api.cyclesim 91 | 92 | end 93 | 94 | 95 | 96 | -------------------------------------------------------------------------------- /src/cosim2.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Icarus Verilog Cosimulation interface *) 12 | 13 | (** run [sets], then [gets] then schedule next callback at cur_time+[delta_time]*) 14 | type delta_message = 15 | { 16 | sets : (int * int32 list) list; 17 | gets : int list; 18 | delta_time : int64; 19 | } 20 | 21 | (** expected inputs and outputs *) 22 | type init_message = string list 23 | 24 | (** control message *) 25 | type control_message = 26 | | Finish 27 | | Run of delta_message 28 | 29 | (** response message *) 30 | type response_message = (int * int32 list) list 31 | 32 | (* XXX to parameterise *) 33 | val net_addr : string 34 | val net_port : int 35 | 36 | (** basic TCP communications between client (simulation) and server (hardcaml) *) 37 | module Comms : sig 38 | open Unix 39 | val create_client : string -> int -> file_descr 40 | val create_server : string -> int -> file_descr 41 | val accept_client : file_descr -> file_descr 42 | 43 | val send : file_descr -> bytes -> unit 44 | val send_int : file_descr -> int -> unit 45 | val send_int32 : file_descr -> int32 -> unit 46 | val send_int64 : file_descr -> int64 -> unit 47 | val send_string : file_descr -> string -> unit 48 | 49 | val recv : file_descr -> bytes -> int -> unit 50 | val recv_int : file_descr -> int 51 | val recv_int32 : file_descr -> int32 52 | val recv_int64 : file_descr -> int64 53 | val recv_string : file_descr -> string 54 | val recv_string_is : file_descr -> string -> unit 55 | end 56 | 57 | (** send a control message to the simulation *) 58 | val control : Unix.file_descr -> control_message -> response_message 59 | 60 | (** write test harness *) 61 | val write_testbench : ?dump_file:string -> 62 | name:string -> inputs:(string*int) list -> outputs:(string*int) list -> 63 | (string -> unit) -> unit 64 | 65 | (** write test hardness derivied from a hardcaml circuit *) 66 | val write_testbench_from_circuit : ?dump_file:string -> (string -> unit) -> Circuit.t -> unit 67 | 68 | (** find clocks and resets in a hardcaml circuit *) 69 | val derive_clocks_and_resets : Circuit.t -> string list * string list 70 | 71 | module type Simulator = sig 72 | 73 | (** compile verilog files *) 74 | val compile : string list -> string -> unit 75 | 76 | (** load simulation along with vpi object *) 77 | val load_sim : ?opts:string -> string -> unit 78 | 79 | (** compile circuit and load simulation *) 80 | val compile_and_load_sim : ?dump_file:string -> ?opts:string -> Circuit.t -> unit 81 | 82 | end 83 | 84 | module Icarus : Simulator 85 | 86 | module Mti32 : Simulator 87 | 88 | module Mti64 : Simulator 89 | 90 | module Make(SIM : Simulator)(B : Comb.S) : sig 91 | 92 | val init_sim : (unit -> unit) -> (string * int) list -> 93 | Unix.file_descr * (string * (int * int)) list 94 | 95 | val make_sim_obj : 96 | server:Unix.file_descr -> 97 | clocks:(string * int) list -> resets:(string * int) list -> 98 | inputs:(string * int) list -> outputs:(string * int) list -> 99 | nets:(string * (int * int)) list -> 100 | B.t Cyclesim.Api.cyclesim 101 | 102 | (** create simulator from hardcaml circuit *) 103 | val make : ?dump_file:string -> ?opts:string -> Circuit.t -> B.t Cyclesim.Api.cyclesim 104 | 105 | (** load icarus vvp simulation *) 106 | val load : 107 | ?opts:string -> 108 | clocks:(string * int) list -> resets:(string * int) list -> 109 | inputs:(string * int) list -> outputs:(string * int) list -> 110 | string -> B.t Cyclesim.Api.cyclesim 111 | 112 | end 113 | 114 | 115 | 116 | -------------------------------------------------------------------------------- /src/cyclesim.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Cycle accurate simulator *) 12 | 13 | open Signal.Types 14 | 15 | (** circuit scheduler *) 16 | val scheduler : (signal -> signal list) -> signal list -> signal list -> signal list 17 | 18 | (** circuit searching *) 19 | val find_elements : Circuit.t -> (signal list * signal list * signal list * signal list * signal list) 20 | 21 | type signal_bundles = 22 | { 23 | schedule : Signal.Comb.t list; 24 | internal_ports : Signal.Comb.t list; 25 | regs : Signal.Comb.t list; 26 | mems : Signal.Comb.t list; 27 | consts : Signal.Comb.t list; 28 | inputs : Signal.Comb.t list; 29 | remaining : Signal.Comb.t list; 30 | ready : Signal.Comb.t list; 31 | } 32 | 33 | val get_maps : 34 | ref:('a -> 'b) -> const:(string -> 'a) -> zero:(int -> 'a) -> bundle:signal_bundles -> 35 | 'b UidMap.t * 36 | 'b UidMap.t * 37 | 'a array UidMap.t 38 | 39 | (** Cycle based simulator type and API *) 40 | module Api : 41 | sig 42 | 43 | type task = unit -> unit 44 | 45 | (** base type of the cycle based simulators *) 46 | type 'a cyclesim = 47 | { 48 | sim_in_ports : (string * 'a ref) list; 49 | sim_out_ports : (string * 'a ref) list; 50 | sim_out_ports_next : (string * 'a ref) list; 51 | sim_internal_ports : (string * 'a ref) list; 52 | sim_reset : task; 53 | sim_cycle_check : task; 54 | sim_cycle_comb0 : task; 55 | sim_cycle_seq : task; 56 | sim_cycle_comb1 : task; 57 | sim_lookup_signal : uid -> 'a ref; 58 | sim_lookup_reg : uid -> 'a ref; 59 | sim_lookup_memory : uid -> 'a array; 60 | } 61 | 62 | (** advance by 1 clock cycle (check->comb->seq->comb) *) 63 | val cycle : 'a cyclesim -> unit 64 | 65 | (** check inputs are valid before a simulation cycle *) 66 | val cycle_check : 'a cyclesim -> unit 67 | 68 | (** update combinatorial logic before sequential logic *) 69 | val cycle_comb0 : 'a cyclesim -> unit 70 | 71 | (** update sequential logic *) 72 | val cycle_seq : 'a cyclesim -> unit 73 | 74 | (** update combinatorial logic after sequential logic *) 75 | val cycle_comb1 : 'a cyclesim -> unit 76 | 77 | (** reset simulator *) 78 | val reset : 'a cyclesim -> unit 79 | 80 | (** get input port given a name *) 81 | val in_port : 'a cyclesim -> string -> 'a ref 82 | 83 | (** get output port given a name *) 84 | val out_port : 'a cyclesim -> string -> 'a ref 85 | 86 | (** get output port given a name *) 87 | val out_port_next : 'a cyclesim -> string -> 'a ref 88 | 89 | (** get internal port given a name *) 90 | val internal_port : 'a cyclesim -> string -> 'a ref 91 | 92 | (** get list of input ports *) 93 | val in_ports : 'a cyclesim -> (string * 'a ref) list 94 | 95 | (** get list of output ports *) 96 | val out_ports : 'a cyclesim -> (string * 'a ref) list 97 | 98 | (** get list of output ports *) 99 | val out_ports_next : 'a cyclesim -> (string * 'a ref) list 100 | 101 | (** get list of internal nodes *) 102 | val internal_ports : 'a cyclesim -> (string * 'a ref) list 103 | 104 | end 105 | 106 | (** Generate a simulator using the given Bits API *) 107 | module Make(Bits : Comb.S) : (sig 108 | 109 | type t 110 | 111 | type cyclesim = t Api.cyclesim 112 | 113 | type get_internal = (Signal.Types.signal -> bool) option 114 | type run_inst = Signal.Types.instantiation -> t list -> t list 115 | type get_inst = string -> run_inst option 116 | 117 | (** construct a simulator from a circuit *) 118 | val make : ?log:(string->unit) -> ?internal:get_internal -> 119 | ?inst:get_inst -> 120 | Circuit.t -> cyclesim 121 | 122 | exception Sim_comparison_failure of int * string * string * string 123 | 124 | (** combine 2 simulators. The inputs are set on the 1st simulator and 125 | copied to the 2nd. Outputs are checked and any differences cause 126 | a Sim_comparison_failure exception. *) 127 | val combine_strict : cyclesim -> cyclesim -> cyclesim 128 | 129 | (** combine 2 simulators. Similar to combine_strict except the 130 | simulators may have different sets of input and output ports. 131 | Copying and checking only occurs on signals which exist in 132 | both simulators. *) 133 | val combine_relaxed : cyclesim -> cyclesim -> cyclesim 134 | 135 | module InstOps : sig 136 | type add_inst = string -> run_inst -> signal array -> int array -> 137 | signal array 138 | val make : unit -> get_inst * add_inst 139 | 140 | module Real(P : sig val mk : add_inst end) : sig 141 | module type Real = sig 142 | val (+:) : signal -> signal -> signal 143 | val (-:) : signal -> signal -> signal 144 | val ( *: ) : signal -> signal -> signal 145 | val (/:) : signal -> signal -> signal 146 | val (%:) : signal -> signal -> signal 147 | val ( **: ) : signal -> signal -> signal 148 | val exp : signal -> signal 149 | val log : signal -> signal 150 | val log10 : signal -> signal 151 | val cos : signal -> signal 152 | val sin : signal -> signal 153 | val tan : signal -> signal 154 | val acos : signal -> signal 155 | val asin : signal -> signal 156 | val atan : signal -> signal 157 | val atan2 : signal -> signal -> signal 158 | val cosh : signal -> signal 159 | val sinh : signal -> signal 160 | val tanh : signal -> signal 161 | val ceil : signal -> signal 162 | val floor : signal -> signal 163 | val abs : signal -> signal 164 | end 165 | module Float : Real 166 | module Double : Real 167 | end 168 | 169 | end 170 | 171 | end with type t = Bits.t) 172 | 173 | module MakeRaw(Bits : Bits.Raw.S) : sig 174 | 175 | type cyclesim = Bits.t Api.cyclesim 176 | 177 | type get_internal = (Signal.Types.signal -> bool) option 178 | type run_inst = Signal.Types.instantiation -> Bits.t list -> Bits.t list 179 | type get_inst = string -> run_inst option 180 | 181 | val make : ?log:(string->unit) -> ?internal:get_internal -> 182 | ?inst:get_inst -> 183 | Circuit.t -> cyclesim 184 | 185 | end 186 | 187 | module Sim_obj_if : sig 188 | 189 | module type S = sig 190 | type t 191 | type i = < 192 | i : int -> unit; 193 | i32 : int32 -> unit; 194 | i64 : int64 -> unit; 195 | d : string -> unit; 196 | hu : string -> unit; 197 | hs : string -> unit; 198 | c : string -> unit; 199 | ibl : int list -> unit; 200 | bits : t ref; 201 | > 202 | val input : t ref -> i 203 | type o = < 204 | i : int; 205 | s : int; 206 | i32 : int32; 207 | s32 : int32; 208 | i64 : int64; 209 | s64 : int64; 210 | str : string; 211 | bits : t 212 | > 213 | val output : t ref -> o 214 | end 215 | 216 | module Make(B : Comb.S) : S with type t = B.t 217 | 218 | end 219 | 220 | (** Interactive simulator *) 221 | module Interactive(B : Comb.S) : 222 | sig 223 | 224 | (** Run interactive simulator *) 225 | val run : Pervasives.in_channel -> B.t Api.cyclesim -> unit 226 | 227 | end 228 | 229 | module BinaryIO : 230 | sig 231 | 232 | type t = Bits.Ext.Comb.BigarraybitsNativeint.t 233 | 234 | type cyclesim = t Api.cyclesim 235 | 236 | val wrap : 237 | ?rdin:Pervasives.in_channel option -> 238 | ?wrin:Pervasives.out_channel option -> 239 | ?cmpout:Pervasives.in_channel option -> 240 | ?cmpfn:(string-> t -> t -> unit) -> 241 | ?wrout:Pervasives.out_channel option -> 242 | cyclesim -> cyclesim 243 | 244 | end 245 | 246 | -------------------------------------------------------------------------------- /src/fixed.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Fixed point arithmetic. 12 | 13 | [ 14 | (* select bits type *) 15 | module F = Fixed.Make(Bits) 16 | (* select Signed/Unsigned fixed type, and overflow and rounding mode. *) 17 | module S = F.Signed.Make(struct 18 | let round = F.Signed.Round.tie_to_nearest_even 19 | let overflow = F.Signed.Overflow.saturate 20 | end) 21 | ] 22 | 23 | *) 24 | 25 | module Make(B : Comb.S) : sig 26 | 27 | type unsigned 28 | type signed 29 | 30 | type 'a round 31 | type 'a overflow 32 | 33 | (** various different rounding modes *) 34 | module type Round = sig 35 | type t 36 | val neg_infinity : t 37 | val pos_infinity : t 38 | val to_zero : t 39 | val away_from_zero : t 40 | val tie_to_neg_infinity : t 41 | val tie_to_pos_infinity : t 42 | val tie_to_zero : t 43 | val tie_away_from_zero : t 44 | val tie_to_nearest_even : t 45 | val tie_to_nearest_odd : t 46 | val generic : B.t -> t 47 | val eval : t -> int -> B.t -> B.t 48 | end 49 | 50 | (** overflow control - wrap or saturate *) 51 | module type Overflow = sig 52 | type t 53 | val wrap : t 54 | val saturate : t 55 | val eval : t -> int -> int -> B.t -> B.t 56 | end 57 | 58 | (** fixed point API *) 59 | module type Fixed = sig 60 | type t 61 | 62 | val mk : int -> B.t -> t 63 | (** create a fixed point value. [mk f x] will have [f] fractional bits. 64 | [width x - f] will be the number of integer bits *) 65 | 66 | val int : t -> B.t 67 | (** return the integer part of the value *) 68 | 69 | val frac : t -> B.t 70 | (** return the fractional part of the value *) 71 | 72 | val signal : t -> B.t 73 | (** return the underlying bits *) 74 | 75 | val width_int : t -> int 76 | (** number of integer bits *) 77 | 78 | val width_frac : t -> int 79 | (** number of fractional bits *) 80 | 81 | val to_float : t -> float 82 | (** convert fixed point value to a float *) 83 | 84 | val select_int : t -> int -> B.t 85 | (** [select_int f x] extracts the integer part, and resizes it to x bits. 86 | Bits are dropped from the msb down, if required. *) 87 | 88 | val select_frac : t -> int -> B.t 89 | (** [select_frac f x] extracts the fractional part, and resizes it to x bits. 90 | Bits are dropped from the lsb up, if required. *) 91 | 92 | val select : t -> int -> int -> t 93 | (** resizes a fixed type using select_int and select_frac *) 94 | 95 | val norm : t list -> t list 96 | (** find largest integer and fractional parts in each fixed value, and 97 | resize all elements to that size *) 98 | 99 | val norm2 : t -> t -> t * t 100 | (** same as norm, but for 2 values *) 101 | 102 | val const : int -> int -> float -> t 103 | (** create a fixed value with the given number of integer and fractional bits 104 | from the floating point value *) 105 | 106 | val (+:) : t -> t -> t 107 | (** adition *) 108 | 109 | val (-:) : t -> t -> t 110 | (** subtraction *) 111 | 112 | val ( *: ) : t -> t -> t 113 | (** multiplication *) 114 | 115 | val (==:) : t -> t -> B.t 116 | (** equality *) 117 | 118 | val (<>:) : t -> t -> B.t 119 | (** inequality *) 120 | 121 | val (<:) : t -> t -> B.t 122 | (** less than *) 123 | 124 | val (<=:) : t -> t -> B.t 125 | (** less than or equal to *) 126 | 127 | val (>:) : t -> t -> B.t 128 | (** greater than *) 129 | 130 | val (>=:) : t -> t -> B.t 131 | (** greater than or equal to *) 132 | 133 | val mux : B.t -> t list -> t 134 | (** multiplexor *) 135 | 136 | val resize : t -> int -> int -> t 137 | (** [resize x i f] will resize the integer part to have [i] bits, and 138 | fractional part to have [f] bits. Rounding and overflow control 139 | is applied *) 140 | 141 | end 142 | 143 | module Unsigned : sig 144 | module Round : (Round with type t = unsigned round) 145 | module Overflow : (Overflow with type t = unsigned overflow) 146 | module type Spec = sig 147 | val round : Round.t 148 | val overflow : Overflow.t 149 | end 150 | module Make(S : Spec) : Fixed 151 | end 152 | 153 | module Signed : sig 154 | module Round : (Round with type t = signed round) 155 | module Overflow : (Overflow with type t = signed overflow) 156 | module type Spec = sig 157 | val round : Round.t 158 | val overflow : Overflow.t 159 | end 160 | module Make(S : Spec) : Fixed 161 | end 162 | 163 | end 164 | 165 | 166 | -------------------------------------------------------------------------------- /src/graph.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Write circuit as graph. Currently works quite well with aisee3; www.aisee.com *) 12 | 13 | val write_dot_rank : Pervasives.out_channel -> Circuit.t -> unit 14 | 15 | (** write a GDL (graph description language) file of the given circuit *) 16 | val write_gdl : 17 | ?names:bool -> ?widths:bool -> 18 | ?consts:bool -> ?clocks:bool -> 19 | Pervasives.out_channel -> Circuit.t -> unit 20 | 21 | (** launch aisee3 to visualize the given circuit *) 22 | val aisee3 : 23 | ?args:string -> 24 | ?names:bool -> ?widths:bool -> 25 | ?consts:bool -> ?clocks:bool -> 26 | Circuit.t -> unit 27 | 28 | -------------------------------------------------------------------------------- /src/interface.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Circuit interfaces as module - used with camlp4 extension *) 12 | 13 | module type S = sig 14 | type 'a t 15 | val t : (string * int) t 16 | val map : ('a -> 'b) -> 'a t -> 'b t 17 | val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 18 | val to_list : 'a t -> 'a list 19 | end 20 | 21 | module type Empty = sig 22 | type 'a t = None 23 | val t : (string * int) t 24 | val map : ('a -> 'b) -> 'a t -> 'b t 25 | val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 26 | val to_list : 'a t -> 'a list 27 | end 28 | 29 | module Empty : Empty 30 | 31 | val combine : (module S) -> (module S) -> (module S) 32 | val prefix : string -> (module S) -> (module S) 33 | val postfix : string -> (module S) -> (module S) 34 | 35 | module Gen(B : Comb.S)(I : S)(O : S) : sig 36 | val make : string -> (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 37 | (Circuit.t * B.t Cyclesim.Api.cyclesim * B.t ref I.t * B.t ref O.t * B.t ref O.t) 38 | end 39 | 40 | module Gen_cosim(B : Comb.S)(I : S)(O : S) : sig 41 | val make : string -> (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 42 | (Circuit.t * B.t Cyclesim.Api.cyclesim * B.t ref I.t * B.t ref O.t * B.t ref O.t) 43 | end 44 | 45 | module Gen_cosim2(SIM : Cosim2.Simulator)(B : Comb.S)(I : S)(O : S) : sig 46 | val make : string -> (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 47 | (Circuit.t * B.t Cyclesim.Api.cyclesim * B.t ref I.t * B.t ref O.t * B.t ref O.t) 48 | end 49 | 50 | module Circ(I : S)(O : S) : sig 51 | val make : string -> (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 52 | Circuit.t 53 | end 54 | 55 | module Sim(B : Comb.S)(I : S)(O : S) : sig 56 | val make : string -> (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 57 | (Circuit.t * B.t Cyclesim.Api.cyclesim * B.t ref I.t * B.t ref O.t * B.t ref O.t) 58 | end 59 | 60 | module Inst(I : S)(O : S) : sig 61 | val make : string -> Signal.Comb.t I.t -> Signal.Comb.t O.t 62 | end 63 | 64 | module Hier(I : S)(O : S) : sig 65 | val make : 66 | ?check_names:bool -> Circuit.Hierarchy.database -> string -> 67 | (Signal.Comb.t I.t -> Signal.Comb.t O.t) -> 68 | Signal.Comb.t I.t -> Signal.Comb.t O.t 69 | end 70 | 71 | module type Ex = sig 72 | 73 | type 'a t 74 | 75 | val t : (string * int) t 76 | val to_list : 'a t -> 'a list 77 | 78 | val mapname : (string -> 'a) -> 'a t 79 | val mapbits : (int -> 'a) -> 'a t 80 | 81 | val zip2 : 'a t -> 'b t -> ('a * 'b) t 82 | val zip3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 83 | val zip4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t 84 | val zip5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t 85 | val zip6 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> ('a * 'b * 'c * 'd * 'e * 'f) t 86 | 87 | val map : 88 | ('a -> 'b) -> 89 | 'a t -> 'b t 90 | val map2 : 91 | ('a -> 'b -> 'c) -> 92 | 'a t -> 'b t -> 'c t 93 | val map3 : 94 | ('a -> 'b -> 'c -> 'd) -> 95 | 'a t -> 'b t -> 'c t -> 'd t 96 | val map4 : 97 | ('a -> 'b -> 'c -> 'd -> 'e) -> 98 | 'a t -> 'b t -> 'c t -> 'd t -> 'e t 99 | val map5 : 100 | ('a -> 'b -> 'c -> 'd -> 'e -> 'f) -> 101 | 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t 102 | val map6 : 103 | ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) -> 104 | 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> 'g t 105 | 106 | val iter : 107 | ('a -> unit) -> 108 | 'a t -> unit 109 | val iter2 : 110 | ('a -> 'b -> unit) -> 111 | 'a t -> 'b t -> unit 112 | val iter3 : 113 | ('a -> 'b -> 'c -> unit) -> 114 | 'a t -> 'b t -> 'c t -> unit 115 | val iter4 : 116 | ('a -> 'b -> 'c -> 'd -> unit) -> 117 | 'a t -> 'b t -> 'c t -> 'd t -> unit 118 | val iter5 : 119 | ('a -> 'b -> 'c -> 'd -> 'e -> unit) -> 120 | 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> unit 121 | val iter6 : 122 | ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> unit) -> 123 | 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> 'f t -> unit 124 | 125 | val offsets : ?rev:bool -> unit -> int t 126 | 127 | module type S = sig 128 | 129 | type b 130 | type ifs 131 | 132 | val wire : unit -> ifs 133 | val wiren : unit -> ifs 134 | val consti : int -> ifs 135 | val zero : ifs 136 | val one : ifs 137 | val ones : ifs 138 | 139 | val (&:) : ifs -> ifs -> ifs 140 | val (|:) : ifs -> ifs -> ifs 141 | val (^:) : ifs -> ifs -> ifs 142 | val (~:) : ifs -> ifs 143 | 144 | val ( +: ) : ifs -> ifs -> ifs 145 | val ( -: ) : ifs -> ifs -> ifs 146 | val ( *: ) : ifs -> ifs -> ifs 147 | val ( *+ ) : ifs -> ifs -> ifs 148 | 149 | val pack : ?rev:bool -> ifs -> b 150 | val unpack : ?rev:bool -> b -> ifs 151 | 152 | module L : sig 153 | type 'a l = 'a list t 154 | val empty : unit -> 'a l 155 | val rev : 'a l -> 'a l 156 | val map : ('a t -> 'b t) -> 'a l -> 'b l 157 | val cons : 'a t -> 'a l -> 'a l 158 | val hd : 'a l -> 'a t 159 | val tl : 'a l -> 'a l 160 | val of_list : 'a t list -> 'a l 161 | val to_list : 'a l -> 'a t list 162 | end 163 | 164 | val mux : b -> ifs list -> ifs 165 | val mux2 : b -> ifs -> ifs -> ifs 166 | val concat : ifs list -> ifs 167 | val select : int -> int -> ifs -> ifs 168 | val msb : ifs -> ifs 169 | val msbs : ifs -> ifs 170 | val lsb : ifs -> ifs 171 | val lsbs : ifs -> ifs 172 | 173 | end 174 | 175 | module Make(B : Comb.S) : S 176 | with type b = B.t 177 | and type ifs = B.t t 178 | 179 | end 180 | 181 | module Ex(X : S) : Ex with type 'a t = 'a X.t 182 | 183 | open Signal.Types 184 | 185 | type param = string * int 186 | type ienv = param -> signal 187 | type oenv = param -> signal -> signal 188 | 189 | module Tuple : sig type _ t end 190 | module Curried : sig type (_,_) t end 191 | 192 | module Fn : sig 193 | 194 | exception Parameter_validation of string * int * int 195 | 196 | val (!) : param -> signal Tuple.t 197 | 198 | val (@) : 'a Tuple.t -> 'b Tuple.t -> ('a * 'b) Tuple.t 199 | 200 | val ( @-> ) : param -> ('a, 'b) Curried.t -> (signal -> 'a, 'b) Curried.t 201 | 202 | val returning : 'a Tuple.t -> ('a, 'a) Curried.t 203 | 204 | type ('a,'b) defn = ('a,'b) Curried.t * 'a 205 | 206 | val define : ('a,'b) Curried.t -> 'a -> ('a,'b) defn 207 | 208 | val call : ('a,'b) defn -> 'a 209 | 210 | type inst_env = 211 | { 212 | input : ienv; 213 | output : oenv; 214 | } 215 | 216 | val inst : inst_env -> ('a,'b) defn -> 'b 217 | 218 | val returns : ('a,'b) defn -> 'b -> signal list 219 | 220 | val ioenv : inst_env 221 | 222 | val circuit : string -> ('a,'b) defn -> Circuit.t 223 | 224 | end 225 | 226 | 227 | -------------------------------------------------------------------------------- /src/jbuild: -------------------------------------------------------------------------------- 1 | (jbuild_version 1) 2 | 3 | (library 4 | ((name HardCaml) 5 | (public_name hardcaml) 6 | (libraries (astring unix dynlink num bigarray)))) 7 | 8 | -------------------------------------------------------------------------------- /src/recipe.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open Signal.Comb 12 | open Signal.Seq 13 | 14 | type var = int 15 | type inp = t * t (* enable * value *) 16 | module VMap = Map.Make(struct type t = int let compare = compare end) 17 | type env = 18 | { 19 | freshId : var; 20 | writerInps : inp list VMap.t; 21 | outs : t VMap.t; 22 | } 23 | type 'a recipe = Recipe of (t -> env -> (t * env * 'a)) 24 | 25 | let delay clr d = reg Signal.Types.({ r_sync with reg_clear_value=clr; }) enable d 26 | let delayEn clr enable d = reg Signal.Types.({ r_sync with reg_clear_value=clr; }) enable d 27 | let delayFb clr f = reg_fb Signal.Types.({ r_sync with reg_clear_value=clr }) enable (width clr) f 28 | let setReset s r = delayFb gnd (fun q -> (s |: q) &: (~: r)) 29 | 30 | module Monad = struct 31 | 32 | let return a = 33 | Recipe(fun start env -> (start, env, a)) 34 | 35 | let bind (Recipe m) f = Recipe(fun start env -> 36 | let (fin0, env0, a) = m start env in 37 | let Recipe(f) = f a in 38 | let (fin1, env1, b) = f fin0 env0 in 39 | (fin1, env1, b)) 40 | 41 | let (>>=) = bind 42 | 43 | let (>>) m f = bind m (fun _ -> f) 44 | 45 | end 46 | 47 | open Monad 48 | 49 | let skip = Recipe(fun start env -> (delay gnd start) -- "skip_fin", env, ()) 50 | 51 | let rec wait = function 52 | | 0 -> return () 53 | | n -> skip >> wait (n-1) 54 | 55 | let gen_par_fin comb_fin fin' fin = 56 | let fin = setReset fin' fin in 57 | if comb_fin then fin' |: fin else fin 58 | 59 | let par2 ?(comb_fin=true) (Recipe p) (Recipe q) = Recipe(fun start env -> 60 | let (fin0, env0, a) = p start env in 61 | let (fin1, env1, b) = q start env0 in 62 | let fin = wire 1 in 63 | let () = fin <== (gen_par_fin comb_fin fin0 fin &: gen_par_fin comb_fin fin1 fin) in 64 | (fin, env1, (a,b))) 65 | 66 | let (|||) p q = par2 ~comb_fin:true p q 67 | 68 | let par ?(comb_fin=true) r = Recipe(fun start env -> 69 | let finl, env, al = List.fold_left 70 | (fun (finl,env,al) (Recipe r) -> 71 | let fin, env, a = r start env in 72 | (fin::finl,env,a::al)) ([],env,[]) r 73 | in 74 | let fin = wire 1 -- "par_fin" in 75 | let () = fin <== reduce (&:) (List.map (fun fin' -> gen_par_fin comb_fin fin' fin) finl) in 76 | (fin, env, List.rev al)) 77 | 78 | let cond c (Recipe p) (Recipe q) = Recipe(fun start env -> 79 | let (fin0, env0, _) = p (start &: c) env in 80 | let (fin1, env1, _) = q (start &: (~: c)) env in 81 | ((fin0 |: fin1) -- "cond_fin", env1, ())) 82 | 83 | let iter c (Recipe p) = Recipe(fun start env -> 84 | let ready = wire 1 -- "iter_ready" in 85 | let (fin, env', b) = p ((c &: ready) -- "iter_start") env in 86 | let () = ready <== (start |: fin) in 87 | (((~: c) &: ready) -- "iter_fin", env', b)) 88 | 89 | let forever p = iter vdd p 90 | let waitWhile a = iter a skip 91 | let waitUntil a = iter (~: a) skip 92 | 93 | let follow start (Recipe r) = 94 | let initialEnv = 95 | { 96 | freshId = 0; 97 | writerInps = VMap.empty; 98 | outs = VMap.empty; 99 | } 100 | in 101 | let fin,env,a = r start initialEnv in 102 | (* connect writerInps to outs *) 103 | VMap.iter (fun v o -> 104 | try 105 | let inps = VMap.find v env.writerInps in 106 | let enable = reduce (|:) (List.map fst inps) in 107 | let value = reduce (|:) (List.map (fun (e,v) -> mux2 e v (zero (width v))) inps) in 108 | o <== (delayEn (zero (width o)) enable value) 109 | with _ -> 110 | (* this can lead to combinatorial loops, so perhaps an exception would be better *) 111 | Printf.printf "unassigned var; defaulting to zero\n"; 112 | o <== (zero (width o)) (* unassigned variable *) 113 | ) env.outs; 114 | fin, a 115 | 116 | let createVar env a = 117 | let v = env.freshId in 118 | v, { env with freshId = v+1; outs = VMap.add v a env.outs } 119 | 120 | let ofList al = List.fold_left (fun m (k,v) -> VMap.add k v m) VMap.empty al 121 | 122 | let addInps env al = 123 | let merge _ a b = 124 | match a,b with 125 | | None,None -> None 126 | | Some(a),None 127 | | None,Some(a) -> Some(a) 128 | | Some(a),Some(b) -> Some(a @ b) 129 | in 130 | { env with writerInps = VMap.merge merge (ofList al) env.writerInps } 131 | 132 | let newVar ?name n = Recipe (fun start env -> 133 | let out = match name with None -> wire n | Some(x) -> (wire n) -- x in 134 | let v, env' = createVar env out in 135 | (start, env', v)) 136 | 137 | let readVar v = Recipe(fun start env -> (start, env, VMap.find v env.outs)) 138 | 139 | let assign al = Recipe(fun start env -> 140 | let al' = List.map (fun (a, b) -> a, [start,b]) al in 141 | (delay gnd start, addInps env al', ())) 142 | 143 | let writeVar v a = assign [ v, a ] 144 | 145 | let modifyVar f v = readVar v >>= fun a -> writeVar v (f a) 146 | 147 | let rewriteVar f v w = readVar v >>= fun a -> writeVar w (f a) 148 | 149 | module type Same = sig 150 | type 'a same 151 | val smap : (var -> t) -> var same -> t same 152 | val szip : var same -> t same -> (var * t) list 153 | val newVar : unit -> var same recipe 154 | val read : var same -> t same recipe 155 | val rewrite : (t same -> t same) -> var same -> var same -> unit recipe 156 | val apply : (t same -> t same) -> var same -> unit recipe 157 | val set : var same -> t same -> unit recipe 158 | val ifte : (t same -> t) -> var same -> 'a recipe -> 'b recipe -> unit recipe 159 | val while_ : (t same -> t) -> var same -> 'a recipe -> 'a recipe 160 | end 161 | 162 | module Same(X : Interface.S) = struct 163 | type 'a same = 'a X.t 164 | let smap f t = X.map f t 165 | let szip x y = X.(to_list (map2 (fun a b -> a,b) x y)) 166 | let read a = Recipe(fun start env -> (start, env, smap (fun a -> VMap.find a env.outs) a)) 167 | let rewrite f a b = read a >>= fun x -> assign (szip b (f x)) 168 | let apply f a = rewrite f a a 169 | let set a b = rewrite (fun _ -> b) a a 170 | let ifte f a p q = read a >>= fun b -> cond (f b) p q 171 | let while_ f a p = read a >>= fun b -> iter (f b) p 172 | 173 | let newVar () = 174 | let mkvar n b l = newVar ~name:("newVar_" ^ n) b >>= fun v -> return ((n,v)::l) in 175 | let rec f m l = 176 | match m,l with 177 | | None,[] -> failwith "Same.newVar: no elements" 178 | | None,(n,b)::t -> 179 | f (Some(mkvar n b [])) t 180 | | Some(m),(n,b)::t -> 181 | f (Some(m >>= mkvar n b)) t 182 | | Some(m),[] -> m 183 | in 184 | let m = f None X.(to_list t) in 185 | m >>= fun l -> return (X.map (fun (n,_) -> 186 | try List.assoc n l with Not_found -> failwith ("Not_found " ^ n)) X.t) 187 | 188 | end 189 | 190 | module SVar = Same(struct 191 | type 'a t = 'a 192 | let t = "var", 0 193 | let map f a = f a 194 | let map2 f a b = f a b 195 | let to_list a = [a] 196 | end) 197 | 198 | (* not so sure these are particularly useful; interfaces can do the job better *) 199 | module SList = Same(struct 200 | type 'a t = 'a list 201 | let t = [] 202 | let map = List.map 203 | let map2 = List.map2 204 | let to_list a = a 205 | end) 206 | 207 | module SArray = Same(struct 208 | type 'a t = 'a array 209 | let t = [||] 210 | let map = Array.map 211 | let map2 f a b = Array.init (Array.length a) (fun i -> f a.(i) b.(i)) 212 | let to_list = Array.to_list 213 | end) 214 | 215 | module STuple2 = Same(struct 216 | type 'a t = 'a * 'a 217 | let t = ("a",0), ("b", 0) 218 | let map f (a,b) = (f a, f b) 219 | let map2 f (a,b) (c, d) = (f a c, f b d) 220 | let to_list (a,b) = [ a; b ] 221 | end) 222 | 223 | module STuple3 = Same(struct 224 | type 'a t = 'a * 'a * 'a 225 | let t = ("a",0), ("b", 0), ("c", 0) 226 | let map f (a,b,c) = (f a, f b, f c) 227 | let map2 f' (a,b,c) (d,e,f) = (f' a d, f' b e, f' c f) 228 | let to_list (a,b,c) = [ a; b; c ] 229 | end) 230 | 231 | -------------------------------------------------------------------------------- /src/recipe.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Hardware generation in an imperative style *) 12 | 13 | (** create sequential hardware designs using [if], [while] and [assignment] *) 14 | 15 | open Signal.Comb 16 | 17 | type var 18 | type inp 19 | type env 20 | type 'a recipe 21 | 22 | module Monad : sig 23 | val return : 'a -> 'a recipe 24 | val bind : 'a recipe -> ('a -> 'b recipe) -> 'b recipe 25 | val (>>=) : 'a recipe -> ('a -> 'b recipe) -> 'b recipe 26 | val (>>) : 'a recipe -> 'b recipe -> 'b recipe 27 | end 28 | 29 | (** skip 1 cycle *) 30 | val skip : unit recipe 31 | 32 | (** skip n cycles *) 33 | val wait : int -> unit recipe 34 | 35 | (** perform recipes in parallel. [comb_fin] controls the finish signal 36 | generation. When false and extra cycle is taken after the recipes 37 | complete to generate the [fin] signal. Otherwise extra combinatorial 38 | logic is generated to ensure the [fin] signal toggles on the same 39 | cycle as the last recipe to complete. *) 40 | val par : ?comb_fin:bool -> 'a recipe list -> 'a list recipe 41 | 42 | val par2 : ?comb_fin:bool -> 'a recipe -> 'b recipe -> ('a * 'b) recipe 43 | 44 | val (|||) : 'a recipe -> 'b recipe -> ('a * 'b) recipe 45 | 46 | (** [cond c t f] performs [t] if [c] is high, otherwise performs [f] *) 47 | val cond : t -> 'a recipe -> 'b recipe -> unit recipe 48 | 49 | (** [iter c t] perform [t] while [c] is high *) 50 | val iter : t -> 'a recipe -> 'a recipe 51 | 52 | (** perform recipe forever *) 53 | val forever : 'a recipe -> 'a recipe 54 | 55 | (** wait until [t] is low *) 56 | val waitWhile : t -> unit recipe 57 | 58 | (** wait until [t] is high *) 59 | val waitUntil : t -> unit recipe 60 | 61 | (** follow recipe and get result *) 62 | val follow : t -> 'a recipe -> t * 'a 63 | 64 | (** create an new [n] bit register *) 65 | val newVar : ?name:string -> int -> var recipe 66 | 67 | (** read value of register *) 68 | val readVar : var -> t recipe 69 | 70 | (** assign list of registers - takes 1 cycle *) 71 | val assign : (var * t) list -> unit recipe 72 | 73 | (** write register with value *) 74 | val writeVar : var -> t -> unit recipe 75 | 76 | (** modify current value of resgiter *) 77 | val modifyVar : (t -> t) -> var -> unit recipe 78 | 79 | (** read a register, modify value, write a second register *) 80 | val rewriteVar : (t -> t) -> var -> var -> unit recipe 81 | 82 | module type Same = sig 83 | type 'a same 84 | val smap : (var -> t) -> var same -> t same 85 | val szip : var same -> t same -> (var * t) list 86 | val newVar : unit -> var same recipe 87 | val read : var same -> t same recipe 88 | val rewrite : (t same -> t same) -> var same -> var same -> unit recipe 89 | val apply : (t same -> t same) -> var same -> unit recipe 90 | val set : var same -> t same -> unit recipe 91 | val ifte : (t same -> t) -> var same -> 'a recipe -> 'b recipe -> unit recipe 92 | val while_ : (t same -> t) -> var same -> 'a recipe -> 'a recipe 93 | end 94 | 95 | module Same(X : Interface.S) : Same with type 'a same = 'a X.t 96 | module SVar : Same with type 'a same = 'a 97 | module SList : Same with type 'a same = 'a list 98 | module SArray : Same with type 'a same = 'a array 99 | module STuple2 : Same with type 'a same = 'a * 'a 100 | module STuple3 : Same with type 'a same = 'a * 'a * 'a 101 | 102 | -------------------------------------------------------------------------------- /src/rtl.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** VHDL and Verilog netlist generation *) 12 | 13 | module type Rtl_S = sig 14 | (** [write os circuit] writes [circuit] using [os] for output *) 15 | val write : (string -> unit) -> Circuit.t -> unit 16 | end 17 | 18 | module type OrderedString = (Map.OrderedType with type t = string) 19 | 20 | (* control mapping of signals to their (various) names *) 21 | module type SignalNaming = sig 22 | (* identifier case sensitivity *) 23 | module Case : OrderedString 24 | (* given a name, turn it into a legal identifier *) 25 | val prefix : string 26 | val reserved : string list 27 | val legalize : string -> string 28 | end 29 | 30 | module VerilogNames : SignalNaming 31 | module VhdlNames : SignalNaming 32 | 33 | (** VHDL generation *) 34 | module Vhdl : Rtl_S 35 | 36 | (** Verilog generation *) 37 | module Verilog : Rtl_S 38 | 39 | (** C model generations *) 40 | module C : Rtl_S 41 | 42 | (** Generate circuit with hierarchy *) 43 | module Hierarchy : sig 44 | (** [write ~transforms ~database circuit_name write_module circuit] recursively scans 45 | [circuit] and finds all sub-circuits (ie instantiations). These are looked up in 46 | [database] and [write_module] is called for each sub-circuit. 47 | 48 | Appropriately designed circuits can thus be split over multiple layers of hierarchy 49 | and files. *) 50 | val write : 51 | ?transforms:(Transform.transform_fn list) -> Circuit.Hierarchy.database -> 52 | string -> (string -> Circuit.t -> unit) -> Circuit.t -> unit 53 | end 54 | -------------------------------------------------------------------------------- /src/sim_provider.ml: -------------------------------------------------------------------------------- 1 | module type S = functor (B : Bits.Ext.Comb.S) -> sig 2 | val make : Circuit.t -> B.t Cyclesim.Api.cyclesim 3 | end 4 | 5 | let providers = ref [] 6 | 7 | let add_provider name modl = providers := (name,modl) :: !providers 8 | 9 | let get_provider name = List.assoc name !providers 10 | 11 | let load_provider name = 12 | let name = Dynlink.adapt_filename name in 13 | Dynlink.loadfile name 14 | 15 | let load_provider_from_package package plugin = 16 | let ch = Unix.open_process_in ("ocamlfind query -format \"%d\" " ^ package) in 17 | let path = input_line ch in 18 | let _ = Unix.close_process_in ch in 19 | load_provider (Filename.concat path plugin) 20 | 21 | -------------------------------------------------------------------------------- /src/sim_provider.mli: -------------------------------------------------------------------------------- 1 | module type S = functor (B : Bits.Ext.Comb.S) -> sig 2 | val make : Circuit.t -> B.t Cyclesim.Api.cyclesim 3 | end 4 | 5 | val add_provider : string -> (module S) -> unit 6 | val get_provider : string -> (module S) 7 | val load_provider : string -> unit 8 | val load_provider_from_package : string -> string -> unit 9 | -------------------------------------------------------------------------------- /src/structural.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Simplified HardCaml API that includes tri-states - used for toplevel module generation *) 12 | 13 | type name = string 14 | type id = int 15 | type width = int 16 | 17 | type signal = 18 | | Empty 19 | 20 | (* module interface *) 21 | | Module_input of id * name * width 22 | | Module_output of id * name * width * signal ref 23 | | Module_tristate of id * name * width * signal list ref 24 | 25 | (* internal wires *) 26 | | Internal_wire of id * width * signal ref 27 | | Internal_triwire of id * width * signal list ref 28 | 29 | (* instantiations *) 30 | | Instantiation_output of id * name (* reference to instantiation *) 31 | | Instantiation_tristate of id * name 32 | | Instantiation of id * name * 33 | (string * generic) list * 34 | (string * signal) list * (* inputs (read) *) 35 | (string * signal) list * (* outputs (write; drive wires/module outputs *) 36 | (string * signal) list (* tristate (write; drive triwires/module tristates *) 37 | 38 | (* basic RTL operators *) 39 | | Rtl_op of id * width * rtl_op 40 | 41 | and rtl_op = 42 | | Constant of string 43 | | Select of int * int * signal 44 | | Concat of signal list 45 | | Mux of signal * signal list 46 | 47 | and generic = 48 | | GInt of int 49 | | GFloat of float 50 | | GString of string 51 | | GUnquoted of string 52 | 53 | type circuit = 54 | { 55 | name : string; 56 | id : id; 57 | mutable signals : signal list; 58 | } 59 | 60 | exception Invalid_submodule_input_connection of string * string * signal 61 | exception Invalid_submodule_output_connection of string * string * signal 62 | exception Invalid_submodule_tristate_connection of string * string * signal 63 | exception Wire_already_assigned of signal 64 | exception Invalid_assignment_target of signal 65 | exception Cant_assign_wire_with of signal 66 | exception Cant_assign_triwire_with of signal 67 | 68 | exception Invalid_name of signal 69 | exception Invalid_width of signal 70 | exception Invalid_id of signal 71 | 72 | exception Invalid_constant of string 73 | exception Rtl_op_arg_not_readable of signal 74 | exception Too_few_mux_data_elements 75 | exception Too_many_mux_data_elements of int 76 | exception All_mux_data_elements_must_be_same_width of int list 77 | exception No_elements_to_concat 78 | exception Select_index_error of int * int 79 | exception Binop_arg_widths_different of string 80 | 81 | exception No_circuit 82 | exception Circuit_already_started 83 | 84 | (* start circuit *) 85 | val circuit : string -> unit 86 | (* complete circuit, add to database *) 87 | val end_circuit : unit -> unit 88 | (* find circuit in database *) 89 | val find_circuit : string -> circuit 90 | 91 | val width : signal -> int 92 | 93 | val mk_input : string -> int -> signal 94 | val mk_output : string -> int -> signal 95 | val mk_tristate : string -> int -> signal 96 | 97 | val mk_wire : int -> signal 98 | val mk_triwire : int -> signal 99 | 100 | val (<==) : signal -> signal -> unit 101 | 102 | val is_connected : signal -> bool 103 | 104 | val inst : 105 | ?g:(string * generic) list -> 106 | ?i:(string * signal) list -> 107 | ?o:(string * signal) list -> 108 | ?t:(string * signal) list -> string -> unit 109 | 110 | val (==>) : 'a -> 'b -> 'a * 'b 111 | 112 | val const : string -> signal 113 | val constz : int -> signal 114 | val mux : signal -> signal list -> signal 115 | val concat : signal list -> signal 116 | val select : signal -> int -> int -> signal 117 | 118 | module type Config = sig 119 | val structural_const : bool 120 | val structural_mux : bool 121 | val structural_concat : bool 122 | val structural_select : bool 123 | end 124 | 125 | val prefix : string 126 | 127 | (* the comb API must be (rebuilt) between each circuit *) 128 | module Base(C : Config) : Comb.T with type t = signal 129 | 130 | (* progressively more structural APIs *) 131 | module Base0 : Comb.T with type t = signal 132 | module Base1 : Comb.T with type t = signal (* + mux,concat,select *) 133 | module Base2 : Comb.T with type t = signal (* + consts *) 134 | 135 | val write_verilog : (string -> unit) -> circuit -> unit 136 | 137 | module Lib : sig 138 | 139 | val reg : clock:signal -> en:signal -> signal -> signal 140 | val reg_r : clock:signal -> reset:signal -> ?def:int -> en:signal -> signal -> signal 141 | val reg_c : clock:signal -> clear:signal -> ?def:int -> en:signal -> signal -> signal 142 | val reg_rc : clock:signal -> reset:signal -> clear:signal -> ?def:int -> en:signal -> 143 | signal -> signal 144 | 145 | val tristate_buffer : en:signal -> i:signal -> t:signal -> signal 146 | 147 | end 148 | 149 | -------------------------------------------------------------------------------- /src/transform.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** {2 transform circuits to a different representation} *) 12 | 13 | module type CombBaseGates = sig 14 | type t 15 | val width : t -> int 16 | val const : string -> t 17 | val empty : t 18 | val select : t -> int -> int -> t 19 | val concat : t list -> t 20 | val wire : int -> t 21 | val to_int : t -> int 22 | val to_bstr : t -> string 23 | val to_string : t -> string 24 | val (<==) : t -> t -> unit 25 | val (--) : t -> string -> t 26 | val (~:) : t -> t 27 | val (&:) : t -> t -> t 28 | val (|:) : t -> t -> t 29 | val (^:) : t -> t -> t 30 | end 31 | 32 | module MakeCombGates(S : CombBaseGates) : Comb.T with type t = S.t 33 | module MakeGates(B : Comb.T)(S : sig 34 | val (~:) : B.t -> B.t 35 | val (&:) : B.t -> B.t -> B.t 36 | val (|:) : B.t -> B.t -> B.t 37 | val (^:) : B.t -> B.t -> B.t 38 | end) : Comb.T with type t = B.t 39 | 40 | (** comb logic built from And-Invertor graphs *) 41 | module MakeAig(B : Comb.T) : (Comb.T with type t = B.t) 42 | (** comb logic built from NAND gates *) 43 | module MakeNand(B : Comb.T) : (Comb.T with type t = B.t) 44 | (** comb logic built from NOR gates *) 45 | module MakeNor(B : Comb.T) : (Comb.T with type t = B.t) 46 | 47 | open Signal.Types 48 | 49 | module Signals : 50 | sig 51 | (** AIG circuits *) 52 | module Aig : (Comb.S with type t = signal) 53 | (** NAND circuits *) 54 | module Nand : (Comb.S with type t = signal) 55 | (** NOR circuits *) 56 | module Nor : (Comb.S with type t = signal) 57 | end 58 | 59 | type 'a transform_fn' = (uid -> 'a) -> signal -> 'a 60 | type transform_fn = signal transform_fn' 61 | 62 | module type TransformFn' = 63 | sig 64 | type t 65 | val transform : t transform_fn' 66 | val rewrite : t transform_fn' -> signal UidMap.t -> signal list -> t list 67 | val rewrite_signals : t transform_fn' -> signal list -> t list 68 | end 69 | 70 | module type TransformFn = 71 | sig 72 | (** function which will map signals to a new representation *) 73 | val transform : transform_fn 74 | end 75 | 76 | (** functor to build the function to map a signal to a new combinatorial signal representation *) 77 | module MakePureCombTransform(B : Comb.T) : TransformFn' with type t = B.t 78 | 79 | (** functor to build the function to map a signal to a new combinatorial signal representation *) 80 | module MakeCombTransform(B : (Comb.T with type t = signal)) : TransformFn 81 | 82 | (** AIG gate mapping *) 83 | module AigTransform : TransformFn 84 | (** NAND gate mapping *) 85 | module NandTransform : TransformFn 86 | (** NOR gate mapping *) 87 | module NorTransform : TransformFn 88 | 89 | (** simple copying transform *) 90 | module CopyTransform : TransformFn 91 | 92 | (** simplify concatentations and selects *) 93 | module SimplifyBusses : TransformFn 94 | 95 | (* simplify constants by sharing *) 96 | module SimplifyConstants : TransformFn 97 | 98 | (* constant propagation *) 99 | module ConstantPropagation : TransformFn 100 | 101 | (** rewrites the list of signals based on the given function *) 102 | val rewrite_signals : transform_fn -> signal list -> signal list 103 | 104 | (** rewrites a circuit *) 105 | val rewrite_circuit : transform_fn -> Circuit.t -> Circuit.t 106 | 107 | -------------------------------------------------------------------------------- /src/utils.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open Astring 12 | 13 | exception Failure of string 14 | let failwith str = raise (Failure str) 15 | 16 | type signed = Signed | Unsigned 17 | 18 | (* detect if we are running on a 32 or 64 bit platform *) 19 | let platform_bits = 20 | let min = Nativeint.min_int in 21 | let tst = Nativeint.shift_left 1n 31 in 22 | if min = tst then 32 else 64 23 | 24 | (* some simple composition/pipelining operators *) 25 | let (|>) x f = f x 26 | let (>>) f g x = g (f x) 27 | let (<<) g f x = g (f x) 28 | let ($) f a = f a 29 | 30 | (* Conversions *) 31 | 32 | let list_of_string s = 33 | let len = String.length s in 34 | let rec str i = 35 | if i = len then [] 36 | else s.[i] :: str (i+1) 37 | in 38 | str 0 39 | 40 | let int_of_hchar c = 41 | match c with 42 | | '0' -> 0 43 | | '1' -> 1 44 | | '2' -> 2 45 | | '3' -> 3 46 | | '4' -> 4 47 | | '5' -> 5 48 | | '6' -> 6 49 | | '7' -> 7 50 | | '8' -> 8 51 | | '9' -> 9 52 | | 'a' | 'A' -> 10 53 | | 'b' | 'B' -> 11 54 | | 'c' | 'C' -> 12 55 | | 'd' | 'D' -> 13 56 | | 'e' | 'E' -> 14 57 | | 'f' | 'F' -> 15 58 | | _ -> failwith "Invalid hex char" 59 | 60 | let int_of_bchar = function 61 | | '0' -> 0 62 | | '1' -> 1 63 | | _ -> failwith ("int_of_bin_char: Invalid binary character encountered") 64 | 65 | let t_of_bstr (lsl) (lor) zero one b = 66 | List.fold_left (fun acc v -> (acc lsl 1) lor (if v='1' then one else zero)) 67 | zero (list_of_string b) 68 | 69 | let int_of_bstr = t_of_bstr (lsl) (lor) 0 1 70 | let int32_of_bstr = t_of_bstr Int32.shift_left Int32.logor 0l 1l 71 | let int64_of_bstr = t_of_bstr Int64.shift_left Int64.logor 0L 1L 72 | let nativeint_of_bstr = t_of_bstr Nativeint.shift_left Nativeint.logor 0n 1n 73 | 74 | let bstr_of_int w d = 75 | let rec b i d = 76 | if i = w then "" 77 | else b (i+1) (d asr 1) ^ (if d land 1 = 1 then "1" else "0") 78 | in 79 | b 0 d 80 | 81 | let bstr_of_int32 w d = 82 | let module I = Int32 in 83 | let rec b i d = 84 | if i = w then "" 85 | else b (i+1) (I.shift_right d 1) ^ 86 | (if I.logand d 1l = 1l then "1" else "0") 87 | in 88 | b 0 d 89 | 90 | let bstr_of_int64 w d = 91 | let module I = Int64 in 92 | let rec b i d = 93 | if i = w then "" 94 | else b (i+1) (I.shift_right d 1) ^ 95 | (if I.logand d 1L = 1L then "1" else "0") 96 | in 97 | b 0 d 98 | 99 | let bstr_of_nint w d = 100 | let module I = Nativeint in 101 | let rec b i d = 102 | if i = w then "" 103 | else b (i+1) (I.shift_right d 1) ^ 104 | (if I.logand d 1n = 1n then "1" else "0") 105 | in 106 | b 0 d 107 | 108 | let rec bstr_of_intbitslist = function 109 | | [] -> "" 110 | | h::t -> (if h = 1 then "1" else "0") ^ (bstr_of_intbitslist t) 111 | 112 | let intbitslist_of_bstr s = 113 | let len = String.length s in 114 | let rec make i = 115 | if i = len then [] 116 | else 117 | (if s.[i] = '1' then 1 else 0) :: make (i+1) 118 | in 119 | make 0 120 | 121 | let int_of_hstr s = 122 | let len = String.length s in 123 | let v = ref 0 in 124 | for i = 0 to (len-1) do 125 | v := (!v lsl 4) lor (int_of_hchar s.[i]) 126 | done; 127 | !v 128 | 129 | let ssub v o l = String.Sub.to_string @@ String.sub ~start:o ~stop:(o+l) v 130 | 131 | let bstr_of_hstr sign width hex = 132 | let len = String.length hex in 133 | let len4 = len * 4 in 134 | let rec make_string i = 135 | if i = 0 then "" 136 | else (make_string (i-1)) ^ (bstr_of_int 4 (int_of_hchar hex.[i-1])) in 137 | let result = make_string len in 138 | if width < len4 then 139 | ssub result (len4-width) (width) 140 | else 141 | (String.v ~len:(width - len4) (fun _ -> (if sign = Signed then result.[0] else '0'))) ^ result 142 | 143 | let rec hstr_of_bstr sign s = 144 | let hex_of_bin s = 145 | match s with 146 | | "0000" -> "0" 147 | | "0001" -> "1" 148 | | "0010" -> "2" 149 | | "0011" -> "3" 150 | | "0100" -> "4" 151 | | "0101" -> "5" 152 | | "0110" -> "6" 153 | | "0111" -> "7" 154 | | "1000" -> "8" 155 | | "1001" -> "9" 156 | | "1010" -> "a" 157 | | "1011" -> "b" 158 | | "1100" -> "c" 159 | | "1101" -> "d" 160 | | "1110" -> "e" 161 | | "1111" -> "f" 162 | | _ -> failwith "Invalid string" 163 | in 164 | let len = String.length s in 165 | match len with 166 | | 0 -> failwith "Invalid string" 167 | | 1 | 2 | 3 -> 168 | hex_of_bin 169 | ((if sign = Signed then String.v ~len:(4-len) (fun _ -> s.[0]) 170 | else String.v ~len:(4-len) (fun _ -> '0')) ^ s) 171 | | 4 -> hex_of_bin s 172 | | _ -> hstr_of_bstr sign (ssub s 0 (len-4)) ^ hex_of_bin (ssub s (len-4) 4) 173 | 174 | (* ... *) 175 | 176 | let abits_of_bstr' platform_bits (|.) (<<.) zero one get set create b = 177 | let width = String.length b in 178 | let words = (width + platform_bits - 1) / platform_bits in 179 | let a = create words zero in 180 | let rec build n = 181 | let word = n / platform_bits in 182 | let bit = n mod platform_bits in 183 | if b.[width - n - 1] = '1' then 184 | set a (word) ((get a word) |. (one <<. bit)); 185 | if n <> 0 then 186 | build (n-1) 187 | in 188 | build (width-1); 189 | a 190 | 191 | let bstr_of_abits' platform_bits (&.) (<<.) zero one get set width a = 192 | if width = 0 then "" 193 | else 194 | let b = Bytes.make width '0' in 195 | let rec build n = 196 | let word = n / platform_bits in 197 | let bit = n mod platform_bits in 198 | if ((get a word) &. (one <<. bit)) <> zero then 199 | Bytes.set b (width - n - 1) '1'; 200 | if n <> 0 then 201 | build (n-1) 202 | in 203 | build (width-1); 204 | Bytes.to_string b 205 | 206 | (* ... *) 207 | 208 | let abits_int32_of_bstr = abits_of_bstr' 32 (Int32.logor) (Int32.shift_left) 0l 1l 209 | Array.get Array.set 210 | Array.make 211 | 212 | let bstr_of_abits_int32 = bstr_of_abits' 32 (Int32.logand) (Int32.shift_left) 0l 1l 213 | Array.get Array.set 214 | 215 | let abits_int64_of_bstr = abits_of_bstr' 64 (Int64.logor) (Int64.shift_left) 0L 1L 216 | Array.get Array.set 217 | Array.make 218 | 219 | let bstr_of_abits_int64 = bstr_of_abits' 64 (Int64.logand) (Int64.shift_left) 0L 1L 220 | Array.get Array.set 221 | 222 | let abits_nint_of_bstr = abits_of_bstr' platform_bits (Nativeint.logor) (Nativeint.shift_left) 0n 1n 223 | Array.get Array.set 224 | Array.make 225 | 226 | let bstr_of_abits_nint = bstr_of_abits' platform_bits (Nativeint.logand) (Nativeint.shift_left) 0n 1n 227 | Array.get Array.set 228 | 229 | 230 | (* number + list handling *) 231 | 232 | let rec nbits x = 233 | if x < 0 then failwith "arg to clog2 must be >= 0"; 234 | match x with 0 | 1 -> 1 | x -> 1 + (nbits (x/2)) 235 | 236 | let clog2 x = 237 | if x = 0 then 0 238 | else nbits (x-1) 239 | 240 | let rec pow2 n = 2 * (if n<=1 then 1 else pow2 (n-1)) 241 | 242 | let range n = 243 | let rec r0 n i = if n = i then [] else i :: (r0 n (i+1)) in 244 | r0 n 0 245 | 246 | let lselect l lo hi = 247 | let rec ls l idx lo hi = 248 | if idx > hi then [] 249 | else if idx < lo then ls (List.tl l) (idx+1) lo hi 250 | else (List.hd l) :: (ls (List.tl l) (idx+1) lo hi) in 251 | ls l 0 lo hi 252 | 253 | (* Selects the even elements from a list *) 254 | let leven l = 255 | let rec r l n = 256 | match l with 257 | | [] -> [] 258 | | hd :: tl -> 259 | if (n land 1) = 0 260 | then hd :: (r tl (n+1)) 261 | else (r tl (n+1)) in 262 | r l 0 263 | 264 | (* Selects the odd elements from a list *) 265 | let lodd l = 266 | let rec r l n = 267 | match l with 268 | | [] -> [] 269 | | hd :: tl -> 270 | if (n land 1) = 1 271 | then hd :: (r tl (n+1)) 272 | else (r tl (n+1)) in 273 | r l 0 274 | 275 | let linit n f = 276 | Array.init n f |> Array.to_list 277 | 278 | let rec zip a b = 279 | match a,b with 280 | | _,[] -> [] 281 | | [],_ -> [] 282 | | a::b,c::d -> (a,c) :: zip b d 283 | 284 | (* split list of pairs into two separate lists *) 285 | let unzip l = List.map fst l, List.map snd l 286 | 287 | let pairs l = zip (leven l) (lodd l) 288 | 289 | let iteri fn l = 290 | let rec f i l = 291 | match l with 292 | | [] -> () 293 | | h :: t -> fn i h; f (i+1) t 294 | in 295 | f 0 l 296 | 297 | let mapi fn l = 298 | let rec f i l = 299 | match l with 300 | | [] -> [] 301 | | h :: t -> fn i h :: f (i+1) t 302 | in 303 | f 0 l 304 | 305 | let rec map2 fn a b = 306 | match a,b with 307 | | a::s,b::t -> fn a b :: map2 fn s t 308 | | _ -> [] 309 | 310 | let rec iter2 fn a b = 311 | match a,b with 312 | | a::s,b::t -> fn a b; iter2 fn s t 313 | | _ -> () 314 | 315 | let memoize f = 316 | let v = ref None in 317 | (fun a -> 318 | match !v with 319 | | Some(v,a') when a = a' -> v 320 | | _ -> 321 | let v' = f a in 322 | v := Some(v',a); 323 | v' 324 | ) 325 | 326 | let split_pow2 l = 327 | let len = List.length l in 328 | let ll = clog2 len in 329 | match len with 330 | | 0 -> [],[] 331 | | 1 -> l,[] 332 | | 2 -> [List.hd l],List.tl l 333 | | _ -> 334 | let ll = 1 lsl (ll-1) in 335 | lselect l 0 (ll-1), lselect l ll (len-1) 336 | 337 | 338 | -------------------------------------------------------------------------------- /src/utils.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Utility functions *) 12 | 13 | (** sign designator *) 14 | type signed = Signed | Unsigned 15 | 16 | val platform_bits : int 17 | 18 | (** x |> f applies f to x *) 19 | val (|>) : 'a -> ('a -> 'b) -> 'b 20 | 21 | (** forward composition *) 22 | val (>>) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c 23 | 24 | (** reverse composition *) 25 | val (<<) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b 26 | 27 | (** function chaining (avoiding brackets) *) 28 | val ($) : ('a -> 'b) -> 'a -> 'b 29 | 30 | (** converts a string to a list of chars *) 31 | val list_of_string : string -> char list 32 | 33 | (** Integer to hex character (0..15) *) 34 | val int_of_hchar : char -> int 35 | 36 | (** 0 or 1 -> '0' or '1' *) 37 | val int_of_bchar : char -> int 38 | 39 | (** converts a binary string to an integer *) 40 | val int_of_bstr : string -> int 41 | 42 | (** converts a binary string to an integer *) 43 | val int32_of_bstr : string -> int32 44 | 45 | (** converts a binary string to an integer *) 46 | val int64_of_bstr : string -> int64 47 | 48 | (** converts a binary string to an integer *) 49 | val nativeint_of_bstr : string -> nativeint 50 | 51 | (** converts an int to a binary string *) 52 | val bstr_of_int : int -> int -> string 53 | val bstr_of_int32 : int -> Int32.t -> string 54 | val bstr_of_int64 : int -> Int64.t -> string 55 | val bstr_of_nint : int -> Nativeint.t -> string 56 | 57 | (** convert binary string to int bits list *) 58 | val intbitslist_of_bstr : string -> int list 59 | 60 | (** convert a list of bits (from type IntbitsList) to binary string *) 61 | val bstr_of_intbitslist : int list -> string 62 | 63 | (** Convert a hexidecimal string to an integer *) 64 | val int_of_hstr : string -> int 65 | 66 | (** Convert a string in hexadecimal notation to a binary string. 67 | If the hex string is shorter than the required width, and the value 68 | is signed, the result is sign extended. *) 69 | val bstr_of_hstr : signed -> int -> string -> string 70 | 71 | (** convert a binary string to a hex string *) 72 | val hstr_of_bstr : signed -> string -> string 73 | 74 | (** binary string to array of int32 *) 75 | val abits_int32_of_bstr : string -> int32 array 76 | 77 | (** array of int32 to binary string *) 78 | val bstr_of_abits_int32 : int -> int32 array -> string 79 | 80 | (** binary string to array of int32 *) 81 | val abits_int64_of_bstr : string -> int64 array 82 | 83 | (** array of int32 to binary string *) 84 | val bstr_of_abits_int64 : int -> int64 array -> string 85 | 86 | (** binary string to array of int32 *) 87 | val abits_nint_of_bstr : string -> nativeint array 88 | 89 | (** array of int32 to binary string *) 90 | val bstr_of_abits_nint : int -> nativeint array -> string 91 | 92 | (** number of bits required to represent the given int *) 93 | val nbits : int -> int 94 | 95 | (** ceil(log(2,n)), n>=0 *) 96 | val clog2 : int -> int 97 | 98 | (** 2^n *) 99 | val pow2 : int-> int 100 | 101 | (** create list from [0...N] *) 102 | val range : int -> int list 103 | 104 | (** select elements from list; head of list first *) 105 | val lselect : 'a list -> int -> int -> 'a list 106 | 107 | (** get even elements of list *) 108 | val leven : 'a list -> 'a list 109 | 110 | (** get odd elements of list *) 111 | val lodd : 'a list -> 'a list 112 | 113 | (* linit n f : initialise list of n elements *) 114 | val linit : int -> (int -> 'a) -> 'a list 115 | 116 | (** create list of pairs from two lists *) 117 | val zip : 'a list -> 'b list -> ('a * 'b) list 118 | 119 | (** split list of pairs into two separate lists *) 120 | val unzip : ('a * 'b) list -> ('a list * 'b list) 121 | 122 | (** create pairs from list *) 123 | val pairs : 'a list -> ('a * 'a) list 124 | 125 | (** iterate over list with index *) 126 | val iteri : (int -> 'a -> unit) -> 'a list -> unit 127 | 128 | (** map over list with index *) 129 | val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list 130 | 131 | (** iterate over two lists calling the given function *) 132 | val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit 133 | 134 | (** map over two lists calling the given function *) 135 | val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list 136 | 137 | (** memoization of a value *) 138 | val memoize : ('a -> 'b) -> 'a -> 'b 139 | 140 | (** split list on power of two boundary *) 141 | val split_pow2 : 'a list -> 'a list * 'a list 142 | 143 | -------------------------------------------------------------------------------- /src/vcd.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open Astring 12 | 13 | (** VCD (Verilog Change Dump) generation *) 14 | module Make(S : Comb.S) = 15 | struct 16 | 17 | open S 18 | open Circuit 19 | 20 | open Cyclesim.Api 21 | 22 | type t = S.t 23 | 24 | let vcdmin = 33 25 | let vcdmax = 126 26 | let vcdcycle = 10 27 | 28 | type trace = 29 | { 30 | w : int; 31 | id : string; 32 | name : string; 33 | data : S.t ref; 34 | prev : string ref; 35 | } 36 | 37 | type cyclesim = t Cyclesim.Api.cyclesim 38 | 39 | let wrap os sim = 40 | (*let name = "sim" in*) 41 | let osl s = os (s ^ "\n") in 42 | let si = string_of_int in 43 | let (^:^) a b = a ^ " " ^ b in 44 | 45 | (* id generator *) 46 | let gen_id = 47 | let i = ref 2 in (* 0+1 are for clock and reset *) 48 | let range = vcdmax - vcdmin in 49 | let rec gen x = 50 | let d = x / range in 51 | let m = x mod range in 52 | if d = 0 then [m] 53 | else d :: gen (x-range) 54 | in 55 | let code x = List.fold_left (fun a x -> 56 | (String.v ~len:1 (fun _ -> Char.of_byte (x + vcdmin))) ^ a) "" (gen x) in 57 | (fun () -> 58 | let x = !i in 59 | incr i; 60 | code x 61 | ) 62 | in 63 | 64 | let write_var v d w = 65 | if w = 1 then 66 | osl (d^v) 67 | else 68 | osl ("b"^d^:^v) 69 | in 70 | 71 | (* list of signals to trace *) 72 | let trace signals = 73 | let width s = String.length (to_bstr s) in 74 | let xs w = String.v w (fun _ -> 'x') in 75 | List.map (fun (n,s) -> 76 | { 77 | w = width !s; 78 | id = gen_id (); 79 | name = n; 80 | data = s; 81 | prev = ref (xs (width !s)); 82 | } 83 | ) signals 84 | in 85 | let trace_in = trace sim.sim_in_ports in 86 | let trace_out = trace sim.sim_out_ports in 87 | let trace_internal = trace sim.sim_internal_ports in 88 | 89 | (* filter out 'clock' and 'reset' *) 90 | let trace_in = List.filter (fun s -> s.name <> "clock" && s.name <> "reset") trace_in in 91 | 92 | (* write the VCD header *) 93 | let write_header() = 94 | os "$date\n ...\n$end\n"; 95 | os "$version\n HardCaml\n$end\n"; 96 | os "$comment\n Hardware design in ocaml\n$end\n"; 97 | os "$timescale 1ns $end\n"; 98 | os "$scope module inputs $end\n"; 99 | os "$var wire 1 ! clock $end\n"; 100 | os "$var wire 1 \" reset $end\n"; 101 | let trv t = osl ("$var wire "^si t.w^:^t.id^:^t.name^:^"$end") in 102 | List.iter trv trace_in; 103 | os "$upscope $end\n"; 104 | os "$scope module outputs $end\n"; 105 | List.iter trv trace_out; 106 | os "$upscope $end\n"; 107 | os "$scope module various $end\n"; 108 | List.iter trv trace_internal; 109 | os "$upscope $end\n"; 110 | os "$enddefinitions $end\n"; 111 | os "$dumpvars\n"; 112 | os "x!\n"; 113 | os "x\"\n"; 114 | List.iter (fun t -> write_var t.id !(t.prev) t.w) trace_in; 115 | List.iter (fun t -> write_var t.id !(t.prev) t.w) trace_out; 116 | List.iter (fun t -> write_var t.id !(t.prev) t.w) trace_internal; 117 | os "$end\n"; 118 | in 119 | let time = ref 0 in 120 | write_header(); 121 | 122 | (* reset *) 123 | let write_reset () = 124 | osl ("#"^si (!time)); 125 | osl "0!"; 126 | osl "1\""; 127 | List.iter (fun t -> write_var t.id (S.to_bstr !(t.data)) t.w; t.prev := 128 | (S.to_bstr !(t.data))) trace_in; 129 | List.iter (fun t -> write_var t.id (S.to_bstr !(t.data)) t.w; t.prev := 130 | (S.to_bstr !(t.data))) trace_out; 131 | List.iter (fun t -> write_var t.id (S.to_bstr !(t.data)) t.w; t.prev := 132 | (S.to_bstr !(t.data))) trace_internal; 133 | time := !(time) + vcdcycle 134 | in 135 | (* cycle *) 136 | let write_cycle () = 137 | osl ("#"^si (!time)); 138 | osl "1!"; 139 | osl "0\""; 140 | List.iter (fun t -> 141 | let data = S.to_bstr !(t.data) in 142 | if data <> !(t.prev) then 143 | (write_var t.id data t.w; t.prev := data) 144 | ) trace_in; 145 | List.iter (fun t -> 146 | let data = S.to_bstr !(t.data) in 147 | if data <> !(t.prev) then 148 | (write_var t.id data t.w; t.prev := data) 149 | ) trace_out; 150 | List.iter (fun t -> 151 | let data = S.to_bstr !(t.data) in 152 | if data <> !(t.prev) then 153 | (write_var t.id data t.w; t.prev := data) 154 | ) trace_internal; 155 | osl ("#"^si (!(time) + (vcdcycle/2))); 156 | osl "0!"; 157 | time := !(time) + vcdcycle 158 | in 159 | { sim with 160 | sim_reset = (fun () -> reset sim; write_reset()); 161 | sim_cycle_seq = (fun () -> cycle_seq sim; write_cycle()); 162 | } 163 | 164 | end 165 | 166 | module Gtkwave(S : Comb.S) = 167 | struct 168 | 169 | module Vcd = Make(S) 170 | 171 | type t = S.t 172 | type cyclesim = t Cyclesim.Api.cyclesim 173 | 174 | let wrap chan sim = 175 | let o s = 176 | output_string chan s; 177 | flush chan 178 | in 179 | Vcd.wrap o sim 180 | 181 | let gtkwave ?(args="") sim = 182 | let fifoname = Filename.temp_file "sim" "fifo" in 183 | Printf.printf "Created tempfile %s\n" fifoname; 184 | Unix.unlink fifoname; 185 | Unix.mkfifo fifoname 0o600; 186 | Printf.printf "Made fifo, launching shmidcat and gtkwave\n"; 187 | ignore (Unix.open_process_in ("shmidcat " ^ fifoname ^ " | gtkwave -v -I " ^ args)); 188 | let fifo = open_out fifoname in 189 | at_exit (fun () -> Printf.printf "Destroying FIFO\n"; close_out fifo; Unix.unlink fifoname); 190 | wrap fifo sim 191 | 192 | end 193 | 194 | 195 | 196 | 197 | -------------------------------------------------------------------------------- /src/vcd.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** VCD file generation *) 12 | 13 | (** Make vcd generator from a simulator *) 14 | module Make(S : Comb.S) : sig 15 | 16 | open Signal.Types 17 | type t = S.t 18 | 19 | type cyclesim = t Cyclesim.Api.cyclesim 20 | 21 | (** wrap a simulator to generate a vcd file *) 22 | val wrap : (string->unit) -> cyclesim -> cyclesim 23 | 24 | end 25 | 26 | (** Drive the gtkwave waveform viewer *) 27 | module Gtkwave(S : Comb.S) : sig 28 | 29 | open Signal.Types 30 | type t = S.t 31 | 32 | type cyclesim = t Cyclesim.Api.cyclesim 33 | 34 | (** wrap a simulator to generate a vcd file *) 35 | val wrap : out_channel -> cyclesim -> cyclesim 36 | 37 | (** launch gtkwave to view the VCD output interactively *) 38 | val gtkwave : ?args:string -> cyclesim -> cyclesim 39 | 40 | end 41 | 42 | 43 | -------------------------------------------------------------------------------- /src/xilinx.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Basic Xilinx FPGA primitives *) 12 | module type S = 13 | sig 14 | 15 | open Signal.Types 16 | 17 | val lut : int64 -> signal -> signal 18 | 19 | val muxcy : signal -> signal -> signal -> signal 20 | 21 | val inv : signal -> signal 22 | 23 | val xorcy : signal -> signal -> signal 24 | 25 | val muxf5 : signal -> signal -> signal -> signal 26 | 27 | val muxf6 : signal -> signal -> signal -> signal 28 | 29 | val muxf7 : signal -> signal -> signal -> signal 30 | 31 | val muxf8 : signal -> signal -> signal -> signal 32 | 33 | val fdce : signal -> signal -> signal -> signal -> signal 34 | 35 | val fdpe : signal -> signal -> signal -> signal -> signal 36 | 37 | val mult_and : signal -> signal -> signal 38 | 39 | val ram1s : signal -> signal -> signal -> signal -> signal 40 | 41 | end 42 | 43 | (** Allow expressions to generate LUT init values *) 44 | module LutEqn : 45 | sig 46 | 47 | type t 48 | 49 | val i0 : t 50 | val i1 : t 51 | val i2 : t 52 | val i3 : t 53 | val i4 : t 54 | val i5 : t 55 | 56 | val gnd : t 57 | val vdd : t 58 | val (&:) : t -> t -> t 59 | val (|:) : t -> t -> t 60 | val (^:) : t -> t -> t 61 | val (~:) : t -> t 62 | val (==:) : t -> t -> t 63 | val (<>:) : t -> t -> t 64 | 65 | val eval : int -> t -> int64 66 | 67 | end 68 | 69 | (** HardCaml simulation based models of Xilinx primitives *) 70 | module HardCaml_api : S 71 | 72 | (** Unisim library based Xilinx primitives *) 73 | module Unisim : S 74 | 75 | module type T = 76 | sig 77 | 78 | open Signal.Types 79 | 80 | val x_lut : LutEqn.t -> signal -> signal 81 | 82 | val x_map : LutEqn.t -> signal list -> signal 83 | 84 | val x_and : signal -> signal -> signal 85 | 86 | val x_or : signal -> signal -> signal 87 | 88 | val x_xor : signal -> signal -> signal 89 | 90 | val x_not : signal -> signal 91 | 92 | val x_reduce_carry : bool -> (LutEqn.t -> LutEqn.t -> LutEqn.t) -> 93 | signal -> signal -> signal -> signal 94 | 95 | val x_and_reduce : signal -> signal 96 | 97 | val x_or_reduce : signal -> signal 98 | 99 | val x_reduce_tree : (LutEqn.t -> LutEqn.t -> LutEqn.t) -> signal -> signal 100 | 101 | val x_add_carry : LutEqn.t -> signal -> signal -> signal -> (signal * signal) 102 | 103 | val x_add : signal -> signal -> signal 104 | 105 | val x_sub : signal -> signal -> signal 106 | 107 | val x_mux_add_carry : LutEqn.t -> signal -> signal -> (signal * signal) -> signal -> (signal * signal) 108 | 109 | (** [x_mux_add x (a,a') b] gives [(x ? a : a') + b] *) 110 | val x_mux_add : signal -> (signal * signal) -> signal -> signal 111 | 112 | (** [x_mux_sub x a (b,b')] gives [a - (x ? b : b')] *) 113 | val x_mux_sub : signal -> signal -> (signal * signal) -> signal 114 | 115 | val x_eq : signal -> signal -> signal 116 | 117 | val x_lt : signal -> signal -> signal 118 | 119 | val x_mux : signal -> signal list -> signal 120 | 121 | val x_mulu : signal -> signal -> signal 122 | 123 | val x_muls : signal -> signal -> signal 124 | 125 | end 126 | 127 | module type LutSize = sig val max_lut : int end 128 | module Lut4 : LutSize 129 | module Lut6 : LutSize 130 | 131 | module XMake(X : S)(L : LutSize) : T 132 | 133 | module XComb(Synth : T) : (Comb.T with type t = Signal.Types.signal) 134 | 135 | (* combinatorial only transform *) 136 | module XSynthesizeComb(X:S)(L:LutSize) : Transform.TransformFn 137 | (* sequential and combinatorial transform TODO memories *) 138 | module XSynthesize(X:S)(L:LutSize) : Transform.TransformFn 139 | 140 | -------------------------------------------------------------------------------- /staging/README.md: -------------------------------------------------------------------------------- 1 | # Unfinished modules 2 | 3 | * cyclesim2 - sort by different types of event and efficiently deal with the combinatorial output problem 4 | * eventsim[2] - VHDL style event based simulation 5 | * llvmsim - LLVM based simulator - needs porting to opam version of llvm 6 | * float - floating point operations 7 | -------------------------------------------------------------------------------- /staging/cyclesim2.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (* New simulator. We need to fix the following issues; 12 | 13 | * the old simulator didn't really work properly in terms of reading 14 | outputs at the correct time. In some (but not all) cases an output 15 | would not read correctly after a simulation step, even though the correct 16 | sequence of values would actually be generated. Specifically combinatorial 17 | logic after a register update step didn't read correctly. 18 | 19 | * The use of the Comb API for internal calculation is very inefficient, 20 | especially regarding memory usage. All this can be worked out before hand 21 | and should be calculated efficiently using integer arrays. 22 | 23 | * (possible) the fix for the first issue can be resolved by performing 24 | a conditional calculation of dependancies i.e. what updates based on 25 | what inputs/register etc. If we make this generic it might be possible 26 | to perform a multi-clock based simulation. This definitely complicates 27 | the simulator and a simple fallback based mode will be wanted for sure. 28 | Even so it might be well worth it. Note that this would introduce a proper 29 | notion of time so a new VCD writer would be required. 30 | 31 | *) 32 | 33 | (* The first thing to work out is a dependancy scheduler. 34 | 35 | We want to give a number of inputs and calculate what gets updated. 36 | This is a recursive calculation so new dependancies are calculated and 37 | scheduled. 38 | 39 | We want to control where we stop - ie at registers and/or outputs. 40 | 41 | *) 42 | 43 | open Signal.Types 44 | open Circuit 45 | 46 | let (|>) a f = f a 47 | let (>>) f g x = g (f x) 48 | let (<<) f g x = f (g x) 49 | 50 | type uset = UidSet.t 51 | type umap = uset UidMap.t 52 | 53 | type fan = 54 | { 55 | i : umap; 56 | o : umap; 57 | } 58 | 59 | let fanin fan uid = try UidMap.find uid fan.i with Not_found -> UidSet.empty 60 | let fanout fan uid = try UidMap.find uid fan.o with Not_found -> UidSet.empty 61 | 62 | let search1 fan inputs = 63 | (* find fanout *) 64 | let fanout = UidSet.fold (fanout fan >> UidSet.union) inputs UidSet.empty in 65 | let reqs = UidSet.fold (fanin fan >> UidSet.union) fanout UidSet.empty in 66 | fanout, reqs 67 | 68 | let rec searchr fan inputs (fo,r) = 69 | let fanout, reqs = search1 fan inputs in 70 | if fanout = UidSet.empty then (fo,r) 71 | else 72 | searchr fan fanout 73 | (UidSet.union fanout fo, UidSet.union reqs r) 74 | 75 | let search (fan1,fanr) inputs = 76 | (* 1st level *) 77 | let fanout, reqs = search1 fan1 inputs in 78 | (* other levels *) 79 | searchr fanr fanout (fanout,reqs) 80 | 81 | let remove_empty m = 82 | UidMap.map (UidSet.filter (fun u -> u <> (uid Signal_empty))) m 83 | 84 | let mk_fans circ = 85 | let f1 = { i = circ.circ_fanin; o = circ.circ_fanout } in 86 | let f uid set = 87 | let signal = UidMap.find uid circ.circ_id_to_sig in 88 | if is_reg signal || is_mem signal then UidSet.empty 89 | else set 90 | in 91 | let fr = { f1 with o = UidMap.mapi f f1.o } in 92 | let filter f = { i = remove_empty f.i; o = remove_empty f.o } in 93 | filter f1, filter fr 94 | 95 | let schedule1 fan ready remaining = 96 | let ready' = 97 | UidSet.fold 98 | (fun uid ready' -> 99 | let reqs = fanin fan uid in 100 | if UidSet.subset reqs ready then UidSet.add uid ready' 101 | else ready') remaining UidSet.empty 102 | in 103 | if ready' = UidSet.empty then failwith "cannot schedule any signals" 104 | else ready' 105 | 106 | let rec schedule fan ready remaining = 107 | if remaining = UidSet.empty then [] 108 | else 109 | let ready' = schedule1 fan ready remaining in 110 | ready' :: (schedule fan (UidSet.union ready' ready) 111 | (UidSet.diff remaining ready')) 112 | 113 | let uidset_of_list l = List.fold_right (uid >> UidSet.add) l UidSet.empty 114 | 115 | let compile circ = 116 | let fans = mk_fans circ in 117 | let s_inputs = uidset_of_list circ.circ_inputs in 118 | search fans s_inputs 119 | 120 | 121 | -------------------------------------------------------------------------------- /staging/cyclesim2.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open Signal.Types 12 | 13 | type uset = UidSet.t 14 | type umap = uset UidMap.t 15 | 16 | type fan = 17 | { 18 | i : umap; 19 | o : umap; 20 | } 21 | 22 | val fanin : fan -> uid -> uset 23 | val fanout : fan -> uid -> uset 24 | 25 | val search1 : fan -> uset -> uset * uset 26 | val searchr : fan -> uset -> uset * uset -> uset * uset 27 | val search : fan * fan -> uset -> uset * uset 28 | 29 | val mk_fans : Circuit.t -> fan * fan 30 | 31 | val schedule1 : fan -> UidSet.t -> UidSet.t -> UidSet.t 32 | 33 | val schedule : fan -> UidSet.t -> UidSet.t -> UidSet.t list 34 | 35 | val compile : Circuit.t -> uset * uset 36 | 37 | -------------------------------------------------------------------------------- /staging/eventsim.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** event driven simulator *) 12 | 13 | (** event driven simulation. 14 | 15 | We use the following conceptual model 16 | 17 | - 'values' are Comb.S.t 18 | - 'signals' (point to) have a 'value' 19 | - 'events' assign a new 'value' to a 'signal' at the 20 | given time 21 | - 'processes' are (optionally) sensitive to 'events' 22 | occuring on a monitored set of 'signals'. 'events' are 23 | only raised if the data value actually changes. 24 | - 'processes' return new 'events'. This is equivalent to assignment. 25 | - 'time' may only advance 26 | - 'time' is made of two parts - real 'time' and 'delta' step 27 | - an 'event' generated at the current 'time' is scheduled at the 28 | next 'delta' 29 | - 'time' may not decrease 30 | 31 | TODO 32 | 33 | - check if time decreases 34 | - VCD 35 | - testbench API (simpler process model) 36 | - memories 37 | 38 | *) 39 | open HardCaml 40 | 41 | module Make : 42 | functor (B : Comb.S) -> 43 | sig 44 | type time = int 45 | type value = B.t 46 | type id = int 47 | val verbose' : bool ref 48 | 49 | module Event : 50 | sig 51 | type t = { time : time; value : value; signal : id; } 52 | val compare : t -> t -> int 53 | val time : t -> time 54 | val value : t -> value 55 | val signal : t -> id 56 | val mk : time -> value -> id -> t 57 | val to_string : t -> string 58 | end 59 | 60 | module type OrderedEventsSig = 61 | sig 62 | type t 63 | val empty : t 64 | val lowest_time : t -> time option 65 | val pop_lowest : t -> t * Event.t list 66 | val count : t -> int 67 | val add : t -> Event.t -> t 68 | val add_list : Event.t list -> t -> t 69 | val to_list : t -> Event.t list 70 | end 71 | 72 | module OrderedEvents : OrderedEventsSig 73 | 74 | module SignalDatabase : 75 | sig 76 | type t = { name : string; value : value ref; id : int; } 77 | val empty : t 78 | type database = { mutable data : t array; mutable length : int; } 79 | val database : database 80 | val compare : 'a -> 'a -> int 81 | val mk_id : unit -> int 82 | val add : t -> unit 83 | val get_signals : unit -> t array 84 | val mk : value -> string -> t 85 | val value : t -> value 86 | val ref : t -> value ref 87 | val name : t -> string 88 | val id : t -> int 89 | val set : t -> value -> unit 90 | end 91 | 92 | module Process : 93 | sig 94 | 95 | module Control : 96 | sig 97 | type t = { 98 | event : time -> value -> SignalDatabase.t -> Event.t; 99 | active : SignalDatabase.t -> bool; 100 | value : SignalDatabase.t -> value; 101 | } 102 | val mk : 103 | (time -> value -> SignalDatabase.t -> Event.t) -> 104 | (SignalDatabase.t -> bool) -> 105 | (SignalDatabase.t -> value) -> t 106 | end 107 | 108 | type t = { 109 | name : string; 110 | sensitivity_list : SignalDatabase.t list; 111 | run : Control.t -> time -> time -> Event.t list; 112 | } 113 | 114 | val sensitivity_list : t -> SignalDatabase.t list 115 | 116 | val run : t -> Control.t -> time -> time -> Event.t list 117 | 118 | val mk : 119 | string -> 120 | SignalDatabase.t list -> 121 | (Control.t -> time -> time -> Event.t list) -> t 122 | 123 | end 124 | 125 | module Simulator : 126 | sig 127 | 128 | exception SimOver 129 | exception SimError of string 130 | 131 | type simulation 132 | 133 | val make : Process.t list -> simulation 134 | 135 | val init : ?active:bool -> ?initial:bool -> simulation -> simulation 136 | 137 | val run : simulation -> time -> simulation 138 | 139 | val add : simulation -> Event.t list -> simulation 140 | 141 | module Circuit : 142 | sig 143 | 144 | val build : 145 | Circuit.t -> 146 | Process.t list * 147 | (Signal.Types.signal * SignalDatabase.t) list * 148 | (Signal.Types.signal * SignalDatabase.t) list 149 | 150 | val find_signal : 151 | (Signal.Types.signal * 'a) list -> string -> 'a 152 | 153 | end 154 | end 155 | 156 | module Cyclesim : 157 | sig 158 | type t = B.t 159 | type cyclesim = t Cyclesim.Api.cyclesim 160 | val make : Circuit.t -> cyclesim 161 | end 162 | 163 | module Vcd : 164 | sig 165 | end 166 | 167 | end 168 | 169 | module Test : 170 | sig 171 | val test_0 : unit -> unit 172 | val test_1 : unit -> unit 173 | val test_2 : unit -> unit 174 | val test_3 : unit -> unit 175 | end 176 | 177 | 178 | -------------------------------------------------------------------------------- /staging/eventsim2.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open HardCaml 12 | 13 | module B = Bits.Comb.IntbitsList 14 | 15 | type value = B.t 16 | type time = int 17 | 18 | module Signal = struct 19 | 20 | type t = 21 | { 22 | (* current value *) 23 | mutable value : value; 24 | (* time of last transition *) 25 | mutable time : time; 26 | (* debug name *) 27 | name : string; 28 | } 29 | 30 | let mk name width = 31 | { 32 | value = B.zero width; 33 | time = 0; 34 | name = name; 35 | } 36 | 37 | end 38 | 39 | module Event = struct 40 | 41 | type t = 42 | { 43 | (* time of event *) 44 | time : time; 45 | (* value of event *) 46 | value : value; 47 | (* signal to change *) 48 | signal : Signal.t; 49 | } 50 | 51 | let mk time value signal = 52 | { 53 | time = time; 54 | value = value; 55 | signal = signal; 56 | } 57 | 58 | end 59 | 60 | module Process = struct 61 | 62 | type t = 63 | { 64 | sensitivity : Signal.t list; 65 | run : unit -> unit 66 | } 67 | 68 | let mk sensitivity run = 69 | { 70 | sensitivity = sensitivity; 71 | run = run; 72 | } 73 | 74 | let (<==) a b = 75 | 76 | end 77 | 78 | let a = Signal.mk "a" 8 79 | let b = Signal.mk "b" 8 80 | 81 | let proc = Process.mk [a] (fun () -> 82 | (* b <== after 1 a; *) 83 | () 84 | ) 85 | 86 | 87 | 88 | 89 | 90 | -------------------------------------------------------------------------------- /staging/eventsim2.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | open HardCaml 12 | 13 | module B : Comb.S 14 | 15 | type value = B.t 16 | type time = int 17 | 18 | module Signal : sig 19 | 20 | type t = 21 | { 22 | (* current value *) 23 | mutable value : value; 24 | (* time of last transition *) 25 | mutable time : time; 26 | (* debug name *) 27 | name : string; 28 | } 29 | 30 | val mk : string -> int -> t 31 | 32 | end 33 | 34 | module Event : sig 35 | 36 | type t = 37 | { 38 | (* time of even *) 39 | time : time; 40 | (* value of event *) 41 | value : value; 42 | (* signal to change *) 43 | signal : Signal.t; 44 | } 45 | 46 | val mk : time -> value -> Signal.t -> t 47 | 48 | end 49 | 50 | module Process : sig 51 | 52 | type t = 53 | { 54 | sensitivity : Signal.t list; 55 | run : unit -> unit; 56 | } 57 | 58 | val mk : Signal.t list -> (unit -> unit) -> t 59 | 60 | end 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /staging/float.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** Floating point data type (todo) *) 12 | 13 | (** floating point type configuration *) 14 | module type FloatSpec = sig 15 | val exponent_bits : int 16 | val mantissa_bits : int 17 | end 18 | 19 | (** specification of 32 bit floating point numbers *) 20 | module Float32 : FloatSpec 21 | 22 | (** specification of 64 bit floating point numbers *) 23 | module Float64 : FloatSpec 24 | 25 | module type Float = sig 26 | (* base signal type *) 27 | type bt 28 | (* floating point number. *) 29 | type t 30 | val negate : t -> t 31 | val (+:) : t -> t -> t 32 | val (-:) : t -> t -> t 33 | val ( *: ) : t -> t -> t 34 | val (==:) : t -> t -> bt 35 | val (<>:) : t -> t -> bt 36 | val (<:) : t -> t -> bt 37 | val (>:) : t -> t -> bt 38 | val (<=:) : t -> t -> bt 39 | val (>=:) : t -> t -> bt 40 | end 41 | 42 | module type FloatBase = sig 43 | 44 | include Float 45 | 46 | val sign : t -> bt 47 | val exponent : t -> bt 48 | val mantissa : t -> bt 49 | 50 | type ordered_float = 51 | { 52 | a_lt_b : bt; 53 | exp_diff : bt; 54 | min : t; 55 | max : t; 56 | renorm : bt; 57 | state : string; 58 | } 59 | 60 | val fmin : ordered_float -> t 61 | val fmax : ordered_float -> t 62 | 63 | module Const : sig 64 | val max_exp : int 65 | val bias : int 66 | val max_adj_exp : int 67 | val min_adj_exp : int 68 | val bits : int 69 | val zero : t 70 | val min_denormal : t 71 | val max_denormal : t 72 | end 73 | 74 | val to_float : t -> float 75 | val of_float : float -> t 76 | val of_signal : bt -> t 77 | val to_signal : t -> bt 78 | val to_string : t -> string 79 | val pretty_printer : Format.formatter -> t -> unit 80 | val pretty_printer_ord : Format.formatter -> ordered_float -> unit 81 | 82 | val fmux2 : bt -> t -> t -> t 83 | val order : (t * t) -> ordered_float 84 | val align : ordered_float -> ordered_float 85 | val add : ordered_float -> ordered_float 86 | val leading_ones : bt -> bt 87 | val leading_zeros : bt -> bt 88 | val normalize : ordered_float -> ordered_float 89 | val round_mantissa : ordered_float -> ordered_float 90 | val clip_exponent : ordered_float ->ordered_float 91 | val check_nan : t -> t 92 | 93 | val fadd : t -> t -> t 94 | val test_fadd : t -> t -> t * t * 95 | ordered_float * ordered_float * ordered_float * 96 | ordered_float * ordered_float * ordered_float * 97 | t * t 98 | 99 | val mul_mantissa : t -> t -> bt * bt 100 | val mul_exponent : t -> t -> bt -> bt 101 | 102 | end 103 | 104 | (* Construct a floating point module based on the specifications *) 105 | module Make(B : Comb.S) 106 | (S : FloatSpec) 107 | (R : Fixed.Round(B).Unsigned) : 108 | (FloatBase with type bt = B.t) 109 | 110 | module Tagged(B : Comb.S)(G : FloatBase) : Float 111 | 112 | -------------------------------------------------------------------------------- /staging/llvmsim.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (** LLVM based simulation *) 12 | 13 | module type T = 14 | sig 15 | open HardCaml 16 | open HardCamlX 17 | 18 | (** base simulator type *) 19 | type cyclesim = Bits_ext.Comb.BigarraybitsNativeint.t Cyclesim.Api.cyclesim 20 | 21 | (** [make circuit] construct a simulator from [circuit] *) 22 | val make : Circuit.t -> cyclesim 23 | 24 | (** write simulator to bitcode file *) 25 | val write : string -> Circuit.t -> unit 26 | 27 | (** [load name] loads the bit code file called [name] *) 28 | val load : string -> cyclesim 29 | end 30 | 31 | module type S = 32 | sig 33 | open HardCaml 34 | 35 | type t 36 | type cyclesim = t Cyclesim.Api.cyclesim 37 | 38 | (** construct a simulator from a circuit *) 39 | val make : Circuit.t -> cyclesim 40 | 41 | (** write simulator to bitcode file *) 42 | val write : string -> Circuit.t -> unit 43 | 44 | (** load simulator from bitcode file *) 45 | val load : string -> cyclesim 46 | end 47 | 48 | (** Low level LLVM simulator which uses {!Bits_ext.Comb.BigarraybitsNativeint} as 49 | its interface type. Initial version. Generally works fine (except memories 50 | are not implemented) however, for large circuits it can take a very, very 51 | long time to compile. *) 52 | module V1 : T 53 | 54 | (** Low level LLVM simulator which uses {!Bits_ext.Comb.BigarraybitsNativeint} as 55 | its interface type. Broken version - mux's dont work. 56 | This represents an initial attempt at the compilation time problem. *) 57 | module V2 : T 58 | 59 | (** LLVM simulator generator. 60 | Interface is parameterized by the given Bits and simulator type *) 61 | module Make(Base : T)(B : HardCamlX.Bits_ext.S) : (S with type t = B.t) 62 | 63 | 64 | -------------------------------------------------------------------------------- /test/cctb.ml: -------------------------------------------------------------------------------- 1 | (* Demonstrate generator based testbenches built with 2 | * HardCamlCCTB 3 | * 4 | * The key concept is to be able to write multiple generators, 5 | * interacting with different subsets of a circuits interface, 6 | * and having them all synchronised with the simulators 7 | * cycle function automatically. 8 | * 9 | * Using Delimcc we model python-esque generators with a yield 10 | * function. Each generator reads like a mini testbench which 11 | * calls the yield function to perform a simulation cycle. 12 | * 13 | * The CCTB library synchronises all the relevant generators 14 | * with the simulation. 15 | * 16 | * The example below models a circuit with an independant 17 | * adder and multiplier. Different generators drive the 18 | * two operations, and monitor the outputs. 19 | * 20 | * It also demonstrates how new generators and be 'yield'ed 21 | * dynamically. 22 | *) 23 | 24 | (* utop "test/cctb.ml" *) 25 | #require "hardcaml,hardcaml.cctb,hardcaml-waveterm";; 26 | 27 | open HardCaml 28 | open Api 29 | open Comb 30 | open Seq 31 | 32 | module W = HardCamlWaveTerm.Wave.Make(HardCamlWaveTerm.Wave.Bits(B)) 33 | module Ws = HardCamlWaveTerm.Sim.Make(B)(W) 34 | module Widget = HardCamlWaveTerm.Widget.Make(B)(W) 35 | 36 | open Printf 37 | 38 | let f a b = reg r_sync enable (a +: b) 39 | let g a b = reg r_sync enable (a *: b) 40 | 41 | let a = input "a" 8 42 | let b = input "b" 8 43 | let x = input "x" 8 44 | let y = input "y" 8 45 | let c = output "c" (f a b) 46 | let d = output "d" (g x y) 47 | let circ = Circuit.make "foo" [c;d] 48 | let sim = Cyclesim.make circ 49 | let sim, waves = Ws.wrap sim 50 | 51 | let clear = Cs.in_port sim "clear" 52 | let enable = Cs.in_port sim "enable" 53 | let a = Cs.in_port sim "a" 54 | let b = Cs.in_port sim "b" 55 | let x = Cs.in_port sim "x" 56 | let y = Cs.in_port sim "y" 57 | let c = Cs.out_port_next sim "c" 58 | let d = Cs.out_port_next sim "d" 59 | 60 | (********************************************************************) 61 | 62 | (********************************************************************) 63 | open HardCamlCCTB.Cycles 64 | 65 | (* reset, enable and start generators *) 66 | let rec start_gen = `gen begin fun yield -> 67 | clear := B.vdd; 68 | yield []; 69 | clear := B.gnd; 70 | enable := B.vdd; 71 | yield [ 72 | delay add_gen; (* run adder inputs *) 73 | delay (seq [mul_gen; mul_gen]); (* run multiplier inputs, twice *) 74 | delay ~n:2 (show 'a' c); (* show adder output *) 75 | delay ~n:2 (show 'm' d); (* show multiplier output *) 76 | ] 77 | end 78 | 79 | (* set the adder inputs for 10 cycles *) 80 | and add_gen = `gen begin fun yield -> 81 | for i=0 to 9 do 82 | a := B.consti 8 (i+1); 83 | b := B.consti 8 (i+1); 84 | yield []; 85 | done 86 | end 87 | 88 | (* set the multiplier inputs for 5 cycles *) 89 | and mul_gen = `gen begin fun yield -> 90 | for i=0 to 4 do 91 | x := B.consti 8 (i+1); 92 | y := B.consti 8 (i+1); 93 | yield []; 94 | done 95 | end 96 | 97 | (* show outputs *) 98 | and show s p = `gen begin fun yield -> 99 | while true do 100 | printf "%c = %i\n" s (B.to_int !p); 101 | yield [] 102 | done 103 | end 104 | 105 | (* run testbench *) 106 | let test () = 107 | let () = run ~n:18 ~sim start_gen in 108 | let waveform = new Widget.waveform () in 109 | let waves = W.{ cfg={default with wave_width=2}; waves } in 110 | waveform#set_waves waves; 111 | Lwt_main.run @@ Widget.run_widget waveform 112 | 113 | let () = test () 114 | 115 | 116 | -------------------------------------------------------------------------------- /test/gwShowall.tcl: -------------------------------------------------------------------------------- 1 | # Script to automatically add all design signals to the wave window on startup; 2 | # ie 3 | # > gtkwave -S gwShowall.tcl test.vcd 4 | # > testprog | gtkwave -v -S gwShowall.tcl 5 | 6 | set nsigs [ gtkwave::getNumFacs ] 7 | set sigs [list] 8 | for {set i 0} {$i < $nsigs} {incr i} { 9 | set name [ gtkwave::getFacName $i ] 10 | lappend sigs $name 11 | } 12 | 13 | set added [ gtkwave::addSignalsFromList $sigs ] 14 | 15 | -------------------------------------------------------------------------------- /test/intf.ml: -------------------------------------------------------------------------------- 1 | module X : sig 2 | module Intf : sig 3 | type 'a t = { a : 'a }[@@deriving hardcaml] 4 | end 5 | module Ex : Interface.Ex with type 'a t := 'a Intf.t 6 | include Interface.S with type 'a t = 'a Intf.t 7 | end = struct 8 | module Intf = struct 9 | type 'a t = { a : 'a }[@@deriving hardcaml] 10 | end 11 | module Ex : Interface.Ex with type 'a t := 'a Intf.t = Interface.Ex(Intf) 12 | include Intf 13 | end 14 | 15 | module Y : sig 16 | type 'a t = { a : 'a }[@@deriving hardcaml] 17 | module Ex : Interface.Ex with type 'a t := 'a t 18 | end = struct 19 | type 'a t = { a : 'a }[@@deriving hardcaml] 20 | module Ex = Interface.Ex(struct 21 | type 'a x = 'a t 22 | type 'a t = 'a x (* avoid cyclic type error *) 23 | let t = t 24 | let map = map 25 | let map2 = map2 26 | let to_list = to_list 27 | end) 28 | end 29 | -------------------------------------------------------------------------------- /test/ops.ml: -------------------------------------------------------------------------------- 1 | (* test the combinatorial APIs *) 2 | 3 | module Test(T : HardCaml.Comb.S) = struct 4 | 5 | module B = HardCaml.Api.B 6 | 7 | let brand bits = 1 + Random.int bits 8 | 9 | let assert_same label t b = 10 | let t, b = T.to_string t, B.to_string b in 11 | if t <> b then begin 12 | failwith (label ^ ": " ^ t ^ " <> " ^ b) 13 | end 14 | 15 | let op2 label opt opb n max_bits = 16 | for i=0 to n-1 do 17 | let bits = brand max_bits in 18 | let a, b = B.srand bits, B.srand bits in 19 | let c, d = T.constibl a, T.constibl b in 20 | assert_same label (opt c d) (opb a b) 21 | done 22 | 23 | let opm label opt opb n max_bits = 24 | for i=0 to n-1 do 25 | let bitsa, bitsb = brand max_bits, brand max_bits in 26 | let a, b = B.srand bitsa, B.srand bitsb in 27 | let c, d = T.constibl a, T.constibl b in 28 | assert_same label (opt c d) (opb a b) 29 | done 30 | 31 | let op1 label opt opb n max_bits = 32 | for i=0 to n-1 do 33 | let bits = brand max_bits in 34 | let a = B.srand bits in 35 | let c = T.constibl a in 36 | assert_same label (opt c) (opb a) 37 | done 38 | 39 | let sel n max_bits = 40 | let bits = brand max_bits in 41 | let h,l = Random.int bits, Random.int bits in 42 | let h,l = max h l, min h l in 43 | let a = B.srand bits in 44 | let c = T.constibl a in 45 | assert_same "sel" (T.select c h l) (B.select a h l) 46 | 47 | let mux n max_bits = 48 | for i=0 to n-1 do 49 | let sbits = brand 8 in (* limit size of mux *) 50 | let dbits = brand max_bits in 51 | let size = 52 | let n = 1 lsl (sbits-1) in 53 | max 2 (n + Random.int (n+1)) 54 | in 55 | let s = B.srand sbits in 56 | let d = Array.to_list @@ Array.init size (fun _ -> B.srand dbits) in 57 | let s' = T.constibl s in 58 | let d' = List.map T.constibl d in 59 | assert_same "mux" (T.mux s' d') (B.mux s d) 60 | done 61 | 62 | let cat n max_bits = 63 | for i=0 to n-1 do 64 | let cnt = 1 + Random.int 8 in 65 | let d = Array.to_list @@ Array.init cnt (fun _ -> B.srand @@ brand max_bits) in 66 | let d' = List.map T.constibl d in 67 | assert_same "cat" (T.concat d') (B.concat d) 68 | done 69 | 70 | let test n max_bits = 71 | op2 "add" T.(+:) B.(+:) n max_bits; 72 | op2 "sub" T.(-:) B.(-:) n max_bits; 73 | op2 "mulu" T.( *: ) B.( *: ) n max_bits; 74 | op2 "muls" T.( *+ ) B.( *+ ) n max_bits; 75 | op2 "and" T.(&:) B.(&:) n max_bits; 76 | op2 "or" T.(|:) B.(|:) n max_bits; 77 | op2 "xor" T.(^:) B.(^:) n max_bits; 78 | op1 "not" T.(~:) B.(~:) n max_bits; 79 | op2 "eq" T.(==:) B.(==:) n max_bits; 80 | op2 "lt" T.(<:) B.(<:) n max_bits; 81 | sel n max_bits; 82 | mux n max_bits; 83 | cat n max_bits 84 | 85 | end 86 | 87 | 88 | -------------------------------------------------------------------------------- /test/recipes.ml: -------------------------------------------------------------------------------- 1 | (* 2 | > utop 3 | $ #require "hardcaml,ppx_deriving_hardcaml,ppx_let";; 4 | $ #use "test/recipes.ml";; 5 | $ Test_mult.test ();; 6 | $ Test_sha1.test ();; 7 | *) 8 | open HardCaml 9 | open Signal.Comb 10 | open Recipe 11 | open Monad 12 | 13 | module B = Bits.Comb.IntbitsList 14 | module S = Cyclesim.Api 15 | module Vcd = Vcd.Gtkwave(B) 16 | 17 | module Let_syntax = struct 18 | type 'a t = 'a recipe 19 | let return x = Monad.return 20 | let bind e f = Monad.bind e f 21 | end 22 | module Test_mult = struct 23 | 24 | (* interface to the serial multiplier *) 25 | module I = struct 26 | type 'a t = { 27 | start : 'a[@bits 1]; 28 | a : 'a[@bits 8]; 29 | b : 'a[@bits 8]; 30 | }[@@deriving hardcaml] 31 | end 32 | 33 | module O = struct 34 | type 'a t = { 35 | fin : 'a[@bits 1]; 36 | mult : 'a[@bits 8]; 37 | }[@@deriving hardcaml] 38 | end 39 | 40 | module State = struct 41 | type 'a t = { 42 | a : 'a[@bits 8]; 43 | b : 'a[@bits 8]; 44 | acc : 'a[@bits 8]; 45 | }[@@deriving hardcaml] 46 | end 47 | module SState = Same(State) 48 | 49 | (* shift 'a' up and 'b' down while 'b' does not equal zero. 50 | * Add 'b' to the accumulator when the lsb of 'b' is non-zero. *) 51 | let step s = 52 | let open State in 53 | { a = sll s.a 1; b = srl s.b 1; acc=mux2 (lsb s.b) (s.acc +: s.a) s.acc } 54 | 55 | let mult a_in b_in = 56 | let open State in 57 | (*perform 58 | (* create registers *) 59 | state <-- SState.newVar(); 60 | (* set inputs and clear accumulator *) 61 | SState.apply (fun _ -> { a=a_in; b=b_in; acc=zero 8 }) state; 62 | (* serial multiplier *) 63 | SVar.while_ (fun b -> b <>:. 0) state.b 64 | SState.(apply step state); 65 | (* return output *) 66 | acc <-- SVar.read state.acc; 67 | return acc 68 | *) 69 | let%bind state = SState.newVar () in 70 | let%bind () = SState.apply (fun _ -> { a=a_in; b=b_in; acc=zero 8 }) state in 71 | (* serial multiplier *) 72 | let%bind () = 73 | SVar.while_ (fun b -> b <>:. 0) state.b 74 | SState.(apply step state) 75 | in 76 | (* return output *) 77 | let%bind acc = SVar.read state.acc in 78 | return acc 79 | 80 | let top i = 81 | let fin, mult = follow i.I.start @@ mult i.I.a i.I.b in 82 | O.{ fin; mult } 83 | 84 | (* simulation *) 85 | 86 | module G = Interface.Gen(B)(I)(O) 87 | 88 | let test () = 89 | let open I in 90 | let circ,sim,i,o,_ = G.make "serial_mult" top in 91 | (*let () = Rtl.Verilog.write print_string circ*) 92 | 93 | let sim = Vcd.gtkwave ~args:"-S test/gwShowall.tcl" sim in 94 | let enable = S.in_port sim "enable" in 95 | S.reset sim; 96 | 97 | enable := B.vdd; 98 | i.a := B.consti 8 11; 99 | i.b := B.consti 8 17; 100 | i.start := B.vdd; 101 | S.cycle sim; 102 | i.start := B.gnd; 103 | for i=0 to 10 do S.cycle sim done; 104 | 105 | ignore @@ input_line stdin 106 | 107 | end 108 | 109 | (* need arrays, indexed by signals, to complete this *) 110 | module Test_sha1 = struct 111 | 112 | module I = struct 113 | type 'a t = { 114 | start : 'a[@bits 1]; 115 | d : 'a[@bits 32]; 116 | d_valid : 'a[@bits 1]; 117 | }[@@deriving hardcaml] 118 | end 119 | 120 | module O = struct 121 | type 'a t = { 122 | fin : 'a[@bits 1]; 123 | hash : 'a array[@length 5][@bits 32]; 124 | redundant : 'a[@bits 1]; 125 | }[@@deriving hardcaml] 126 | end 127 | 128 | module State = struct 129 | type 'a t = { 130 | counter : 'a[@bits 7]; 131 | h : 'a array[@length 5][@bits 32]; 132 | (*w{|16|}[32]*) 133 | }[@@deriving hardcaml] 134 | end 135 | module SState = Same(State) 136 | 137 | let sha1 i = 138 | let open I in 139 | let open State in 140 | let%bind state = SState.newVar() in 141 | (* reset state *) 142 | let%bind () = SState.apply (fun _ -> 143 | { 144 | counter=zero 7; 145 | h=Array.map (consti32 32) 146 | [| 0x67452301l; 0xEFCDAB89l; 0x98BADCFEl; 0x10325476l; 0xC3D2E1F0l |]; 147 | (*w=Array.init 16 (fun _ -> consti 32 0);*) 148 | }) state in 149 | let%bind () = SVar.while_ (fun s -> s <:. 16) state.counter 150 | begin 151 | (SVar.apply (fun d -> d +:. 1) state.counter); 152 | end in 153 | let%bind () = SState.while_ (fun s -> s.counter <:. 20) state 154 | begin 155 | SVar.apply (fun d -> d +:. 1) state.counter; 156 | end in 157 | let%bind () = SState.while_ (fun s -> s.counter <:. 40) state 158 | begin 159 | SVar.apply (fun d -> d +:. 1) state.counter; 160 | end in 161 | let%bind () = SState.while_ (fun s -> s.counter <:. 60) state 162 | begin 163 | SVar.apply (fun d -> d +:. 1) state.counter; 164 | end in 165 | let%bind () = SState.while_ (fun s -> s.counter <:. 80) state 166 | begin 167 | SVar.apply (fun d -> d +:. 1) state.counter; 168 | end in 169 | SState.read state 170 | 171 | let top i = 172 | let fin, state = follow i.I.start @@ sha1 i in 173 | O.{ 174 | fin; 175 | hash=state.State.h; 176 | redundant = reduce (|:) (I.to_list @@ I.map lsb i); 177 | } 178 | 179 | module G = Interface.Gen(B)(I)(O) 180 | 181 | let test () = 182 | let open I in 183 | let circ,sim,i,o,_ = G.make "sha1" top in 184 | 185 | let sim = Vcd.gtkwave ~args:"-S test/gwShowall.tcl" sim in 186 | let enable = S.in_port sim "enable" in 187 | S.reset sim; 188 | 189 | enable := B.vdd; 190 | i.start := B.vdd; 191 | S.cycle sim; 192 | i.start := B.gnd; 193 | for i=0 to 90 do S.cycle sim done; 194 | 195 | ignore @@ input_line stdin 196 | 197 | (*let () = test ()*) 198 | 199 | end 200 | 201 | 202 | -------------------------------------------------------------------------------- /test/simc.ml: -------------------------------------------------------------------------------- 1 | (* Demonstrate the C based simulator. 2 | 3 | In this flow a c-model of the hardware design is written, then 4 | compiled as a shared libary and loaded through ctypes. A 5 | standard simulator object is constructed. 6 | *) 7 | open HardCaml 8 | open Signal.Comb 9 | 10 | (* simple example hardware design - 2 inputs and 2 outputs *) 11 | 12 | module I = interface 13 | a[6] b[8] 14 | end 15 | 16 | module O = interface 17 | c[9] d[8] 18 | end 19 | 20 | let f i = 21 | { O.c = I.(uresize i.a 9 +: uresize i.b 9); 22 | d = I.(uresize i.a 8 &: uresize i.b 8); 23 | } 24 | 25 | (* generate the C simulation model. Most of the magic happens in 26 | HardCamlCSim.Sim.make *) 27 | 28 | module G = Interface.Circ(I)(O) 29 | module S = Cyclesim.Api 30 | 31 | let make () = 32 | let circ = G.make "adderizer" f in 33 | HardCamlCSim.Sim.make circ 34 | 35 | (* testbench *) 36 | 37 | open HardCaml.Bits.Comb.ArraybitsInt32 38 | open I 39 | open O 40 | 41 | let test () = 42 | 43 | let sim = make () in 44 | 45 | let i = I.(map (fun (n,_) -> S.in_port sim n) t) in 46 | let o = O.(map (fun (n,_) -> S.out_port sim n) t) in 47 | 48 | begin 49 | i.a := consti 6 3; 50 | i.b := consti 8 6; 51 | S.cycle sim; 52 | Printf.printf "%i %i\n" (to_int !(o.c)) (to_int !(o.d)) 53 | end 54 | 55 | let () = test () 56 | 57 | -------------------------------------------------------------------------------- /test/test.v: -------------------------------------------------------------------------------- 1 | module test ( 2 | input clock, 3 | input reset, 4 | input [1:0] a, 5 | input [2:0] b, 6 | output reg [3:0] c, 7 | output reg [4:0] d 8 | ); 9 | 10 | always @(posedge clock or posedge reset) begin 11 | if (reset) begin 12 | c <= 0; 13 | d <= 0; 14 | end else begin 15 | c <= a + b; 16 | d <= a * b; 17 | end 18 | end 19 | 20 | endmodule 21 | 22 | -------------------------------------------------------------------------------- /test/test_lwttb.ml: -------------------------------------------------------------------------------- 1 | (* test lwttb framework using cyclesim *) 2 | module I = struct 3 | type 'a t = { 4 | clk : 'a; 5 | clr : 'a; 6 | ena : 'a; 7 | d : 'a[@bits 8]; 8 | }[@@deriving hardcaml,show] 9 | end 10 | 11 | module O = struct 12 | type 'a t = { 13 | cnt : 'a[@bits 8]; 14 | q : 'a[@bits 8]; 15 | }[@@deriving hardcaml] 16 | end 17 | 18 | open HardCaml 19 | open Signal.Comb 20 | open I 21 | open O 22 | 23 | let f i = 24 | let module Seq = (val (Signal.seq_sync ~clk:i.clk ~clr:i.clr) : Signal.Seq) in 25 | let cnt = Seq.reg_fb ~e:i.ena ~w:8 (fun d -> d +:. 1) in 26 | { cnt; q = i.d } 27 | 28 | module B = HardCaml.Bits.Comb.IntbitsList 29 | module Tb = HardCamlLWTTB.Lwtsim.Make(B)(I)(O) 30 | 31 | open Lwt.Infix 32 | 33 | let ppvec fmt v = Format.fprintf fmt "%s" 34 | (match v with None -> "?" | Some(v) -> string_of_int @@ B.to_int v) 35 | 36 | (* simple counter test *) 37 | let test_cntr sim = 38 | let open Tb in 39 | let%lwt sim = set i.clr B.gnd sim in 40 | let%lwt sim = set i.ena B.vdd sim in 41 | let print sim = 42 | let%lwt sim,_,o = cycle sim in 43 | let%lwt () = Lwt_io.printf "%i\n" (B.to_int o.cnt) in 44 | return sim 45 | in 46 | let%lwt sim = repeat 5 print sim in 47 | let%lwt sim = set i.clr B.vdd sim in 48 | let%lwt sim,_,_ = cycle sim in 49 | let%lwt sim = set i.clr B.gnd sim in 50 | let%lwt sim = repeat 5 print sim in 51 | return sim 52 | 53 | let tb1 () = 54 | let sim = Tb.make "tb1" f in 55 | Lwt_main.run @@ Tb.run sim test_cntr 56 | 57 | (* test thread spawning *) 58 | let test_spawner sim = 59 | let open Tb in 60 | 61 | let%lwt sim = spawn ~log:(fun t -> Lwt_io.printf "====> 1\n") 62 | (fun sim -> 63 | let%lwt sim = setsome { inone with clr = Some(B.gnd); ena = Some(B.vdd) } sim in 64 | let%lwt sim = spawn 65 | ~log:(fun t -> Lwt_io.printf "====> 4\n") 66 | (fun sim -> repeat 11 return_cycle sim) sim 67 | in 68 | repeat 7 return_cycle sim) 69 | sim 70 | in 71 | let%lwt sim = spawn ~log:(fun t -> Lwt_io.printf "====> 2\n") 72 | (fun sim -> repeat 3 return_cycle sim) 73 | sim 74 | in 75 | let%lwt sim = spawn ~log:(fun t -> Lwt_io.printf "====> 3\n") 76 | (fun sim -> repeat 9 return_cycle sim) 77 | sim 78 | in 79 | 80 | let%lwt sim = repeat 5 81 | (fun sim -> 82 | cycle1 sim >>= fun (sim,_,o) -> 83 | Lwt_io.printf "[%i]\n" (B.to_int o.cnt) >> 84 | return sim) sim 85 | in 86 | 87 | return sim 88 | 89 | let tb2 () = 90 | let sim = Tb.make "tb2" f in 91 | Lwt_main.run @@ Tb.run ~log:(fun t -> Lwt_io.printf "======> TOP\n") sim test_spawner 92 | 93 | (* test inputs *) 94 | 95 | let print_t id (sim : Tb.t) = 96 | Lwt_io.printf "%s: %s\n" id (I.show ppvec sim.Tb.inputs) 97 | 98 | let test_inputs sim = 99 | let open Tb in 100 | let%lwt sim = 101 | spawn 102 | ~log:(print_t "[1]") 103 | (fun sim -> 104 | return sim >>= 105 | set i.ena B.vdd >>= 106 | set i.clr B.vdd >>= 107 | set i.d B.(consti 8 10) >>= 108 | return_cycle >>= 109 | spawn 110 | ~log:(print_t "[2]") 111 | (fun sim -> 112 | return sim >>= 113 | set i.ena B.vdd >>= 114 | set i.d B.(consti 8 20) >>= 115 | return_cycle) >>= 116 | return_cycle >>= 117 | set i.d B.(consti 8 30) >>= 118 | return_cycle 119 | ) sim 120 | in 121 | return sim >>= 122 | set i.ena B.gnd >>= 123 | set i.d B.(consti 8 100) >>= 124 | return_cycle >>= 125 | set i.ena B.gnd >>= 126 | set i.d B.(consti 8 110) >>= 127 | return_cycle 128 | 129 | let tb3 () = 130 | let sim = Tb.make "tb3" f in 131 | Lwt_main.run @@ Tb.run ~log:(print_t "top") sim test_inputs 132 | 133 | 134 | -------------------------------------------------------------------------------- /test/test_sim_next.ml: -------------------------------------------------------------------------------- 1 | #require "hardcaml";; 2 | 3 | open HardCaml 4 | open Signal.Comb 5 | open Signal.Seq 6 | 7 | let a = input "a" 8 8 | let w = wire 8 9 | let r = reg r_none vdd w 10 | let () = w <== (r +: a) 11 | 12 | open Api 13 | open HardCaml.Cyclesim.Api 14 | 15 | let circ = Circuit.make "test_next" [ output "r" r; output "w" w ] 16 | let sim = Cyclesim.make circ 17 | let a = in_port sim "a" 18 | let r, r' = out_port sim "r", out_port_next sim "r" 19 | let w, w' = out_port sim "w", out_port_next sim "w" 20 | 21 | let show() = 22 | Printf.printf "r=%i rn=%i w=%i wn=%i\n" 23 | (B.to_int !r) (B.to_int !r') 24 | (B.to_int !w) (B.to_int !w') 25 | 26 | let () = 27 | S.reset sim; 28 | a := B.consti 8 3; 29 | S.cycle sim; show(); 30 | S.cycle sim; show(); 31 | S.cycle sim; show(); 32 | S.cycle sim; show(); 33 | S.cycle sim; show() 34 | 35 | -------------------------------------------------------------------------------- /test/test_vpi.ml: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | open Signal.Comb 3 | open Signal.Seq 4 | 5 | module I = interface 6 | clock[1] reset[1] clear[1] enable a[2] b[2] 7 | end 8 | 9 | module O = interface 10 | c[2] d[2] 11 | end 12 | 13 | let reg i enable d = 14 | reg Signal.Types.{ r_full with 15 | reg_clock = i.I.clock; 16 | reg_reset = i.I.reset; 17 | reg_clear = i.I.clear; 18 | } enable d 19 | 20 | let f i = 21 | let c = i.I.a +: i.I.b in 22 | let d = reg i enable c in 23 | O.{ c; d } 24 | 25 | module B = Bits.Comb.IntbitsList 26 | module G = Interface.Gen(B)(I)(O) 27 | module Gc = Interface.Gen_cosim(B)(I)(O) 28 | module S = Cyclesim.Api 29 | 30 | open I 31 | open O 32 | 33 | module Vcd = Vcd_ext.Make(B) 34 | 35 | let _,sim0,i,o = G.make "cosimtest" f 36 | let sim0 = Vcd.gtkwave ~args:"-S gwShowall.tcl" sim0 37 | let _,sim1,_,_ = Gc.make "cosimtest" f 38 | 39 | module Cs = Cyclesim.Make(B) 40 | let sim = Cs.combine_relaxed sim0 sim1 41 | 42 | 43 | -------------------------------------------------------------------------------- /test/test_vpi_load.ml: -------------------------------------------------------------------------------- 1 | open HardCaml 2 | 3 | let clocks = ["clock",1] 4 | let resets = ["reset",1] 5 | let inputs = ["a",2; "b",3] 6 | let outputs = ["c",4; "d",5] 7 | 8 | let verilog_file_name = "test.v" 9 | let testbench_file_name = "testbench.v" 10 | let vvp_file_name = "test.vvp" 11 | let vcd_file_name = "vpi_load.vcd" 12 | let module_name = "test" 13 | 14 | (* write testbench *) 15 | let file = open_out testbench_file_name 16 | let () = Cosim.write_testbench 17 | ~dump_file:vcd_file_name ~name:module_name 18 | ~inputs:(clocks@resets@inputs) ~outputs (output_string file) 19 | let () = close_out file 20 | 21 | let () = Cosim.compile [verilog_file_name; testbench_file_name] vvp_file_name 22 | 23 | module B = Bits.Comb.IntbitsList 24 | module Co = Cosim.Make(B) 25 | module S = Cyclesim.Api 26 | 27 | let sim = Co.load ~clocks ~resets ~inputs ~outputs vvp_file_name 28 | (* 29 | let () = 30 | S.reset sim; 31 | S.cycle sim; 32 | S.cycle sim; 33 | S.cycle sim 34 | *) 35 | -------------------------------------------------------------------------------- /tools/base64.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2006-2009 Citrix Systems Inc. 3 | * Copyright (c) 2010 Thomas Gazagnaire 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | * 17 | *) 18 | 19 | 20 | (* taken from https://github.com/avsm/ocaml-cohttp/blob/master/cohttp/base64.ml *) 21 | 22 | let code = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" 23 | let padding = '=' 24 | 25 | let of_char x = if x = padding then 0 else String.index code x 26 | 27 | let to_char x = code.[x] 28 | 29 | let decode x = 30 | let words = String.length x / 4 in 31 | let padding = 32 | if String.length x = 0 then 0 else ( 33 | if x.[String.length x - 2] = padding 34 | then 2 else (if x.[String.length x - 1] = padding then 1 else 0)) in 35 | let output = String.make (words * 3 - padding) '\000' in 36 | for i = 0 to words - 1 do 37 | let a = of_char x.[4 * i + 0] 38 | and b = of_char x.[4 * i + 1] 39 | and c = of_char x.[4 * i + 2] 40 | and d = of_char x.[4 * i + 3] in 41 | let n = (a lsl 18) lor (b lsl 12) lor (c lsl 6) lor d in 42 | let x = (n lsr 16) land 255 43 | and y = (n lsr 8) land 255 44 | and z = n land 255 in 45 | output.[3 * i + 0] <- char_of_int x; 46 | if i <> words - 1 || padding < 2 then output.[3 * i + 1] <- char_of_int y; 47 | if i <> words - 1 || padding < 1 then output.[3 * i + 2] <- char_of_int z; 48 | done; 49 | output 50 | 51 | let encode x = 52 | let length = String.length x in 53 | let words = (length + 2) / 3 in (* rounded up *) 54 | let padding = if length mod 3 = 0 then 0 else 3 - (length mod 3) in 55 | let output = String.make (words * 4) '\000' in 56 | let get i = if i >= length then 0 else int_of_char x.[i] in 57 | for i = 0 to words - 1 do 58 | let x = get (3 * i + 0) 59 | and y = get (3 * i + 1) 60 | and z = get (3 * i + 2) in 61 | let n = (x lsl 16) lor (y lsl 8) lor z in 62 | let a = (n lsr 18) land 63 63 | and b = (n lsr 12) land 63 64 | and c = (n lsr 6) land 63 65 | and d = n land 63 in 66 | output.[4 * i + 0] <- to_char a; 67 | output.[4 * i + 1] <- to_char b; 68 | output.[4 * i + 2] <- to_char c; 69 | output.[4 * i + 3] <- to_char d; 70 | done; 71 | for i = 1 to padding do 72 | output.[String.length output - i] <- '='; 73 | done; 74 | output 75 | 76 | -------------------------------------------------------------------------------- /tools/encode.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * hardcaml - hardware design in OCaml 3 | * 4 | * (c) 2014 MicroJamJar Ltd 5 | * 6 | * Author(s): andy.ray@ujamjar.com 7 | * Description: 8 | * 9 | *) 10 | 11 | (* base64 encode png icons used in javscript wave viewer *) 12 | 13 | let buffer = Buffer.create 1024 14 | 15 | let rec read () = 16 | try begin 17 | Buffer.add_char buffer (Char.chr (input_byte stdin)); 18 | read () 19 | end with _ -> 20 | Buffer.contents buffer 21 | 22 | let data = read () 23 | let data = Base64.encode data 24 | 25 | let _ = output_string stdout "\"data:image/png;base64," 26 | let _ = output_string stdout data 27 | let _ = output_string stdout "\"\n" 28 | 29 | 30 | -------------------------------------------------------------------------------- /tools/style.css: -------------------------------------------------------------------------------- 1 | 2 | /* A style for ocamldoc. Daniel C. Buenzli */ 3 | 4 | /* Reset a few things. */ 5 | html,body,div,span,applet,object,iframe,h1,h2,h3,h4,h5,h6,p,blockquote,pre, 6 | a,abbr,acronym,address,big,cite,code,del,dfn,em,font,img,ins,kbd,q,s,samp, 7 | small,strike,strong,sub,sup,tt,var,b,u,i,center,dl,dt,dd,ol,ul,li,fieldset, 8 | form,label,legend,table,caption,tbody,tfoot,thead,tr,th,td 9 | { margin: 0; padding: 0; border: 0 none; outline: 0; font-size: 100%; 10 | font-weight: inherit; font-style:inherit; font-family:inherit; 11 | line-height: inherit; vertical-align: baseline; text-align:inherit; 12 | color:inherit; background: transparent; } 13 | 14 | table { border-collapse: collapse; border-spacing: 0; } 15 | 16 | /* Basic page layout using the user's preferred font sizes */ 17 | 18 | body { font: normal 1em/1.375em helvetica, arial, sans-serif; text-align:left; 19 | margin: 1.375em 10%; min-width: 40ex; max-width: 72ex; 20 | color: black; background: transparent /* url(line-height-22.gif) */; } 21 | 22 | b { font-weight: bold } 23 | em { font-style: italic } 24 | 25 | tt, code, pre { font-family: WorkAroundWebKitAndMozilla, monospace; 26 | font-size: 1em; } 27 | pre code { font-size : inherit; } 28 | .codepre { margin-bottom:1.375em /* after code example we introduce space. */ } 29 | 30 | .superscript,.subscript 31 | { font-size : 0.813em; line-height:0; margin-left:0.4ex;} 32 | .superscript { vertical-align: super; } 33 | .subscript { vertical-align: sub; } 34 | 35 | /* ocamldoc markup workaround hacks */ 36 | 37 | hr, hr + br, div + br, center + br, span + br, ul + br, ol + br, pre + br 38 | { display: none } /* annoying */ 39 | 40 | .codepre br + br { display: none } 41 | h1 + pre { margin-bottom:1.375em} /* Toplevel module description */ 42 | 43 | /* Sections and document divisions */ 44 | 45 | /* .navbar { margin-bottom: -1.375em } */ 46 | h1 { font-weight: bold; font-size: 1.5em; /* margin-top:1.833em; */ 47 | margin-top:0.917em; padding-top:0.875em; 48 | border-top-style:solid; border-width:1px; border-color:#AAA; } 49 | h2 { font-weight: bold; font-size: 1.313em; margin-top: 1.048em } 50 | h3 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 51 | h3 { font-weight: bold; font-size: 1em; margin-top: 1.375em} 52 | h4 { font-style: italic; } 53 | 54 | /* Used by OCaml's own library documentation. */ 55 | h6 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 56 | .h7 { font-weight: bold; font-size: 1em; margin-top: 1.375em } 57 | 58 | p { margin-top: 1.375em } 59 | pre { margin-top: 1.375em } 60 | .info { margin: 0.458em 0em -0.458em 2em;}/* Description of types values etc. */ 61 | td .info { margin:0; padding:0; margin-left: 2em;} /* Description in indexes */ 62 | 63 | ul, ol { margin-top:0.688em; padding-bottom:0.687em; 64 | list-style-position:outside} 65 | ul + p, ol + p { margin-top: 0em } 66 | ul { list-style-type: square } 67 | 68 | 69 | /* h2 + ul, h3 + ul, p + ul { } */ 70 | ul > li { margin-left: 1.375em; } 71 | ol > li { margin-left: 1.7em; } 72 | /* Links */ 73 | 74 | a, a:link, a:visited, a:active, a:hover { color : #00B; text-decoration: none } 75 | a:hover { text-decoration : underline } 76 | *:target {background-color: #FFFF99;} /* anchor highlight */ 77 | 78 | /* Code */ 79 | 80 | .keyword { font-weight: bold; } 81 | .comment { color : red } 82 | .constructor { color : green } 83 | .string { color : brown } 84 | .warning { color : red ; font-weight : bold } 85 | 86 | /* Functors */ 87 | 88 | .paramstable { border-style : hidden ; padding-bottom:1.375em} 89 | .paramstable code { margin-left: 1ex; margin-right: 1ex } 90 | .sig_block {margin-left: 1em} 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | --------------------------------------------------------------------------------