├── .gitignore ├── .ocamlformat ├── CHANGES.md ├── CONTRIBUTING.md ├── LICENSE.md ├── Makefile ├── README.md ├── bin ├── convert.ml ├── convert.mli └── dune ├── dune ├── dune-project ├── hardcaml_of_verilog.opam ├── port_verilog ├── dune ├── hardcaml_port_verilog.ml ├── port_verilog.ml └── port_verilog.mli ├── src ├── circuit_bus_map.ml ├── circuit_bus_map.mli ├── circuit_to_json.ml ├── circuit_to_json.mli ├── dune ├── hardcaml_of_verilog.ml ├── lvt.ml ├── lvt.mli ├── netlist.ml ├── netlist.mli ├── ocaml_module.ml ├── ocaml_module.mli ├── pass.ml ├── pass.mli ├── synthesize.ml ├── synthesize.mli ├── techlib.ml ├── techlib.mli ├── verilog_circuit.ml ├── verilog_circuit.mli ├── verilog_design.ml ├── verilog_design.mli ├── with_interface.ml ├── with_interface.mli ├── yosys_netlist.ml └── yosys_netlist.mli └── test ├── apps ├── mram.ml ├── mram.mli ├── sat_cells.ml.unused ├── wrram.ml └── wrram.mli ├── examples ├── picorv32 │ ├── dune │ ├── picorv32.sexp │ ├── picorv32.v │ ├── test.ml │ └── test.mli └── simple_adder │ ├── carry_save_adder.sexp │ ├── dune │ ├── full_adder.v │ ├── simple_adder.sexp │ ├── simple_adder.v │ ├── simple_adder_16.sexp │ ├── simple_adder_8.sexp │ ├── test.ml │ └── test.mli ├── lib ├── dune ├── hardcaml_of_verilog_test.ml ├── test_circuit.ml ├── test_circuit.mli ├── test_circuit_to_json.ml ├── test_circuit_to_json.mli ├── test_interface.ml ├── test_interface.mli ├── test_json.ml ├── test_json.mli ├── test_synthesize.ml ├── test_synthesize.mli ├── test_verilog_design.ml └── test_verilog_design.mli └── verilog ├── adff.v ├── bbox.v ├── counter.v ├── mem.v └── simlib_chk.v /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | *.install 3 | *.merlin 4 | _opam 5 | 6 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile=janestreet 2 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Release v0.16.0 2 | 3 | * Add a wrapper library called hardcaml_port_verilog which wraps the boilerplate 4 | code needed to write a Hardcaml equivalent to a verilog circuit and have it formally 5 | checked by hardcaml_verify. 6 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | This repository contains open source software that is developed and 2 | maintained by [Jane Street][js]. 3 | 4 | Contributions to this project are welcome and should be submitted via 5 | GitHub pull requests. 6 | 7 | Signing contributions 8 | --------------------- 9 | 10 | We require that you sign your contributions. Your signature certifies 11 | that you wrote the patch or otherwise have the right to pass it on as 12 | an open-source patch. The rules are pretty simple: if you can certify 13 | the below (from [developercertificate.org][dco]): 14 | 15 | ``` 16 | Developer Certificate of Origin 17 | Version 1.1 18 | 19 | Copyright (C) 2004, 2006 The Linux Foundation and its contributors. 20 | 1 Letterman Drive 21 | Suite D4700 22 | San Francisco, CA, 94129 23 | 24 | Everyone is permitted to copy and distribute verbatim copies of this 25 | license document, but changing it is not allowed. 26 | 27 | 28 | Developer's Certificate of Origin 1.1 29 | 30 | By making a contribution to this project, I certify that: 31 | 32 | (a) The contribution was created in whole or in part by me and I 33 | have the right to submit it under the open source license 34 | indicated in the file; or 35 | 36 | (b) The contribution is based upon previous work that, to the best 37 | of my knowledge, is covered under an appropriate open source 38 | license and I have the right under that license to submit that 39 | work with modifications, whether created in whole or in part 40 | by me, under the same open source license (unless I am 41 | permitted to submit under a different license), as indicated 42 | in the file; or 43 | 44 | (c) The contribution was provided directly to me by some other 45 | person who certified (a), (b) or (c) and I have not modified 46 | it. 47 | 48 | (d) I understand and agree that this project and the contribution 49 | are public and that a record of the contribution (including all 50 | personal information I submit with it, including my sign-off) is 51 | maintained indefinitely and may be redistributed consistent with 52 | this project or the open source license(s) involved. 53 | ``` 54 | 55 | Then you just add a line to every git commit message: 56 | 57 | ``` 58 | Signed-off-by: Joe Smith 59 | ``` 60 | 61 | Use your real name (sorry, no pseudonyms or anonymous contributions.) 62 | 63 | If you set your `user.name` and `user.email` git configs, you can sign 64 | your commit automatically with git commit -s. 65 | 66 | [dco]: http://developercertificate.org/ 67 | [js]: https://opensource.janestreet.com/ 68 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | The MIT License 2 | 3 | Copyright (c) 2020--2025 Jane Street Group, LLC 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | INSTALL_ARGS := $(if $(PREFIX),--prefix $(PREFIX),) 2 | 3 | default: 4 | dune build 5 | 6 | install: 7 | dune install $(INSTALL_ARGS) 8 | 9 | uninstall: 10 | dune uninstall $(INSTALL_ARGS) 11 | 12 | reinstall: uninstall install 13 | 14 | clean: 15 | dune clean 16 | 17 | .PHONY: default install uninstall reinstall clean 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Verilog to Hardcaml conversion 2 | ============================== 3 | 4 | Use the opensource Verilog synthesis tool [Yosys](https://github.com/YosysHQ/yosys) 5 | to read a synthesizable Verilog design, convert it to a structural netlist 6 | and save it in a JSON file. 7 | 8 | This library can read the JSON netlist file and reconstruct the design in Hardcaml. 9 | 10 | ### Usage 11 | 12 | The library can be used to convert and load JSON netlists. The yosys 13 | tool must be in the PATH. 14 | 15 | A tool is also provided which can be used to generate OCaml code to 16 | wrap a Verilog design and load it at runtime (either by synthesis with 17 | yosys, or from a pre-generated JSON file). 18 | 19 | ### Compatibility 20 | 21 | The library has been tested mainly with yosys version 0.6 and 0.9. 22 | Some testing was also done with 0.8. No compatibility issues have been 23 | found between versions so far. 24 | 25 | ### Conversion status 26 | 27 | Hardcaml does not support tri-state buffers in general. Circuits 28 | with tri-states will not work. 29 | 30 | A few simlib primitives are not supported in the techlib. These 31 | either wont work in Hardcaml (ie latches) or have yet to be implemented. 32 | In these cases a blackbox module is generated (the implementation of 33 | which can be taken from the yosys simlib). 34 | 35 | ``` 36 | |Status | Modules | 37 | |--------------------|---------------------------------------------------------------------| 38 | | to do | shiftx, fsm, macc, alu | 39 | | bbox only | sr, dlatch, dlatchsr | 40 | | no support planned | tribuf, div, mod, pow, memwr, memrd, meminit, assert, assume, equiv | 41 | ``` 42 | 43 | ### Memories 44 | 45 | Yosys can represent memories in a variety of ways 46 | 47 | 1. Synthesized into technology primitives (ie Xilinx block RAM) `Supported by black boxes` 48 | 2. Converted to registers and muxes `fully supported` 49 | 3. As a $mem cell `supported with some limitations` 50 | 4. As a combination of $memwr, $memrd and $meminit cells `not supported` 51 | 52 | The 2nd option is quite general and should be usable in most cases. That said the 53 | netlist will now implement all memories as registers so the design - as Hardcaml sees it - 54 | may not be very efficient. Uses the following command in yosys. 55 | 56 | ``` 57 | yosys> memory -dff 58 | ``` 59 | 60 | The third option will attempt to keep memories, but implement them using Hardcaml 61 | memory primitives. Hardcaml only supports memories with one read and one 62 | write port whereas in general we need to support multi-port memories with 63 | 64 | * N read ports 65 | * M write ports 66 | * Each write port may be in a different clock domain 67 | * Each read port may be in a different clock domain 68 | * Each read port may be synchronous or asynchronous 69 | * Each read port may be read-before-write or write-before-read (also called fallthrough). 70 | 71 | To support yosys we use a construction called a [LVT multi-port memory](http://fpgacpu.ca/multiport) 72 | which builds more general memory structures from simpler single port memories. The following 73 | limitations are known 74 | 75 | 1. only supports 1 write clock domain 76 | 2. read-before-write and write-before-read behaviour only really makes sense if the read and 77 | write clocks are in the same clock domain. 78 | 3. Memory initialization is not supported. 79 | 80 | In yosys use; 81 | 82 | ``` 83 | yosys> memory -nomap; opt; clean 84 | ``` 85 | 86 | ### Example 87 | 88 | #### Yosys usage 89 | 90 | A simple design with a single module may be converted with; 91 | 92 | ``` 93 | yosys> read_verilog design.v; # load design 94 | yosys> hierarchy; proc; flatten; # structural conversion 95 | yosys> write_json design.json # write json netlist 96 | ``` 97 | 98 | In larger designs with multiple modules and/or memories this might be extended to; 99 | 100 | ``` 101 | yosys> read_verilog design.v # load design 102 | yosys> hierarchy -top # select top level module 103 | yosys> proc; flatten # structural conversion 104 | yosys> memory -nomap # convert memories 105 | yosys> opt -mux_undef; clean # tidy up netlist 106 | yosys> write_json design.json # write json netlist 107 | ``` 108 | 109 | #### Hardcaml usage 110 | 111 | Convert a single Verilog file. 112 | 113 | ```ocaml 114 | let convert_verilog ?verbose ?passes verilog_file = 115 | (* Create a [Verilog_design] which represents the files and modules in the design hierarchy *) 116 | let verilog_design = 117 | Verilog_design.create 118 | ~top:(Verilog_design.Module.create ~module_name:"top" ~path:verilog_file ()) 119 | () 120 | in 121 | (* Synthesize to a [Netlist] *) 122 | let%bind.Or_error netlist = Netlist.create ?verbose ?passes verilog_design in 123 | (* Convert to a Hardcaml [Circuit] *) 124 | let%bind.Or_error verilog_circuit = 125 | Verilog_circuit.create netlist ~top_name:(Verilog_design.top_name verilog_design) 126 | in 127 | Verilog_circuit.to_hardcaml_circuit verilog_circuit 128 | ;; 129 | ``` 130 | 131 | #### Yosys build notes 132 | 133 | You can add a Makefile.conf to configure the build. Set 134 | 135 | ``` 136 | CONFIG=gcc 137 | ENABLE_TCL=0 138 | ``` 139 | 140 | The make all and install processes can both take a prefix so you can 141 | install manually 142 | 143 | ``` 144 | make PREFIX=/final/localtion 145 | make install PREFIX=/local/dir 146 | do_my_install 147 | ``` 148 | -------------------------------------------------------------------------------- /bin/convert.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Stdio 3 | open Hardcaml_of_verilog 4 | 5 | let in_chan = 6 | Command.Arg_type.create (fun n -> In_channel.create n) 7 | |> Command.Flag.optional_with_default In_channel.stdin 8 | ;; 9 | 10 | let out_chan = 11 | Command.Arg_type.create Out_channel.create 12 | |> Command.Flag.optional_with_default Out_channel.stdout 13 | ;; 14 | 15 | let rtl = 16 | Command.Arg_type.create (fun rtl -> 17 | match String.lowercase rtl with 18 | | "verilog" | "vlog" -> Hardcaml.Rtl.Language.Verilog 19 | | "vhdl" -> Hardcaml.Rtl.Language.Vhdl 20 | | rtl -> raise_s [%message "Invalid RTL specification" (rtl : string)]) 21 | |> Command.Flag.optional_with_default Hardcaml.Rtl.Language.Verilog 22 | ;; 23 | 24 | let parsexp s = 25 | match Parsexp.Single.parse_string s with 26 | | Ok s -> Ok s 27 | | Error e -> 28 | Or_error.error_s [%message "Failed to parse sexp" (e : Parsexp.Parse_error.t)] 29 | ;; 30 | 31 | let yosys_netlist_of_json ~file_in = 32 | let%bind.Or_error json = Or_error.try_with (fun () -> In_channel.input_all file_in) in 33 | Expert.Yosys_netlist.of_string json 34 | ;; 35 | 36 | let write_sexp ~file_out sexp_of_t t = 37 | let sexp = Sexp.to_string_hum (sexp_of_t t) in 38 | Out_channel.output_string file_out sexp 39 | ;; 40 | 41 | let netlist_of_json ~file_in = 42 | let%bind.Or_error netlist = yosys_netlist_of_json ~file_in in 43 | Netlist.of_yosys_netlist netlist |> Or_error.ok_exn |> Netlist.get_all_modules 44 | ;; 45 | 46 | let command_json_to_yosys_netlist = 47 | Command.basic 48 | ~summary:"Read a YOSYS JSON netlist and write as Yosys_netlist.t sexp" 49 | [%map_open.Command 50 | let file_in = flag "-i" in_chan ~doc:"JSON input file" 51 | and file_out = flag "-o" out_chan ~doc:"NETLIST output file" in 52 | fun () -> 53 | let yosys_netlist = yosys_netlist_of_json ~file_in in 54 | write_sexp ~file_out [%sexp_of: Expert.Yosys_netlist.t Or_error.t] yosys_netlist] 55 | ;; 56 | 57 | let command_json_to_netlist = 58 | Command.basic 59 | ~summary:"Read a YOSYS JSON netlist and write as Netlist.t sexp" 60 | [%map_open.Command 61 | let file_in = flag "-i" in_chan ~doc:"JSON input file" 62 | and file_out = flag "-o" out_chan ~doc:"NETLIST output file" in 63 | fun () -> 64 | let yosys_netlist = netlist_of_json ~file_in in 65 | write_sexp ~file_out [%sexp_of: Netlist.Module.t list Or_error.t] yosys_netlist] 66 | ;; 67 | 68 | let read_verilog_design ~file_in = 69 | let%bind.Or_error verilog_design = parsexp (In_channel.input_all file_in) in 70 | Or_error.try_with (fun () -> Verilog_design.t_of_sexp verilog_design) 71 | ;; 72 | 73 | let synthesize_to_yosys_netlist ~file_in = 74 | let%bind.Or_error verilog_design = read_verilog_design ~file_in in 75 | let%bind.Or_error netlist = Expert.Synthesize.to_yosys_netlist verilog_design in 76 | Ok netlist 77 | ;; 78 | 79 | let synthesize_to_netlist ~file_in = 80 | let%bind.Or_error verilog_design = read_verilog_design ~file_in in 81 | let%bind.Or_error netlist = Netlist.create verilog_design in 82 | Netlist.get_all_modules netlist 83 | ;; 84 | 85 | let synthesize_to_circuit ~file_in = 86 | let%bind.Or_error verilog_design = read_verilog_design ~file_in in 87 | let%bind.Or_error netlist = Netlist.create verilog_design in 88 | let%bind.Or_error circuit = 89 | Verilog_circuit.create netlist ~top_name:(Verilog_design.top_name verilog_design) 90 | in 91 | let%bind.Or_error circuit = Verilog_circuit.to_hardcaml_circuit circuit in 92 | Ok circuit 93 | ;; 94 | 95 | let write_rtl ~file_out ~rtl (circuit : Hardcaml.Circuit.t) = 96 | Hardcaml.Rtl.create rtl [ circuit ] 97 | |> Hardcaml.Rtl.top_levels_only 98 | |> Rope.to_string 99 | |> Out_channel.output_string file_out 100 | ;; 101 | 102 | let command_synthesize_to_yosys_netlist = 103 | Command.basic 104 | ~summary:"Read a verilog design netlist and write as Yosys_netlist.t sexp" 105 | [%map_open.Command 106 | let file_in = flag "-i" in_chan ~doc:"VLOG_DESIGN input file" 107 | and file_out = flag "-o" out_chan ~doc:"NETLIST output file" in 108 | fun () -> 109 | let netlist = synthesize_to_yosys_netlist ~file_in in 110 | write_sexp ~file_out [%sexp_of: Expert.Yosys_netlist.t Or_error.t] netlist] 111 | ;; 112 | 113 | let command_synthesize_to_netlist = 114 | Command.basic 115 | ~summary:"Read a verilog design and write as Netlist.t sexp" 116 | [%map_open.Command 117 | let file_in = flag "-i" in_chan ~doc:"VLOG_DESIGN input file" 118 | and file_out = flag "-o" out_chan ~doc:"NETLIST output file" in 119 | fun () -> 120 | let netlist = synthesize_to_netlist ~file_in in 121 | write_sexp ~file_out [%sexp_of: Netlist.Module.t list Or_error.t] netlist] 122 | ;; 123 | 124 | let command_synthesize_to_verilog = 125 | Command.basic 126 | ~summary:"Read a verilog design and write as RTL file" 127 | [%map_open.Command 128 | let file_in = flag "-i" in_chan ~doc:"VLOG_DESIGN input file" 129 | and file_out = flag "-o" out_chan ~doc:"RTL output file" 130 | and rtl = flag "-rtl" rtl ~doc:"RTL write verilog (default) or vhdl" in 131 | fun () -> 132 | let circuit = synthesize_to_circuit ~file_in |> Or_error.ok_exn in 133 | write_rtl ~file_out ~rtl circuit] 134 | ;; 135 | 136 | let command_synthesize_to_json = 137 | Command.basic 138 | ~summary:"Read a verilog design and convert to json" 139 | [%map_open.Command 140 | let file_in = flag "-i" in_chan ~doc:"VLOG_DESIGN input file" 141 | and json_file = flag "-o" (required string) ~doc:"JSON output file" in 142 | fun () -> 143 | let result = 144 | let%bind.Or_error verilog_design = read_verilog_design ~file_in in 145 | Expert.Synthesize.to_json_file ~verbose:true verilog_design ~json_file 146 | in 147 | Or_error.ok_exn result] 148 | ;; 149 | 150 | let command_synthesize_to_ocaml_module = 151 | Command.basic 152 | ~summary:"Read a verilog design and convert to an OCaml module" 153 | [%map_open.Command 154 | let file_in = flag "-i" in_chan ~doc:"VLOG_DESIGN input file" 155 | and file_out = flag "-o" out_chan ~doc:"OCAML output file" 156 | and path = flag "-path" (optional string) ~doc:"PREFIX of path to verilog files" in 157 | fun () -> 158 | let ocaml = 159 | let%bind.Or_error verilog_design = read_verilog_design ~file_in in 160 | let verilog_design = 161 | match path with 162 | | None -> verilog_design 163 | | Some path -> 164 | Verilog_design.map_paths verilog_design ~f:(fun vlog_path -> 165 | Filename.concat path vlog_path) 166 | in 167 | let%bind.Or_error netlist = Netlist.create ~verbose:true verilog_design in 168 | let%bind.Or_error circuit = 169 | Verilog_circuit.create 170 | netlist 171 | ~top_name:(Verilog_design.top_name verilog_design) 172 | in 173 | let ocaml = Ocaml_module.to_ocaml verilog_design circuit in 174 | Ok ocaml 175 | in 176 | Out_channel.output_string file_out (Or_error.ok_exn ocaml)] 177 | ;; 178 | 179 | let () = 180 | Command_unix.run 181 | (Command.group 182 | ~summary:"Convert YOSYS JSON netlists" 183 | [ ( "json" 184 | , Command.group 185 | ~summary:"" 186 | [ "yosys-netlist", command_json_to_yosys_netlist 187 | ; "netlist", command_json_to_netlist 188 | ] ) 189 | ; ( "synthesize" 190 | , Command.group 191 | ~summary:"Convert verilog designs" 192 | [ "yosys-netlist", command_synthesize_to_yosys_netlist 193 | ; "netlist", command_synthesize_to_netlist 194 | ; "verilog", command_synthesize_to_verilog 195 | ; "ocaml-module", command_synthesize_to_ocaml_module 196 | ; "json", command_synthesize_to_json 197 | ] ) 198 | ]) 199 | ;; 200 | -------------------------------------------------------------------------------- /bin/convert.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names convert) 4 | (libraries core core_unix.command_unix hardcaml hardcaml_of_verilog parsexp 5 | jane_rope stdio) 6 | (preprocess 7 | (pps ppx_jane))) 8 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/hardcaml_of_verilog/95b767058cfa3ed11fa324ba7f232d496bff6349/dune -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.17) 2 | -------------------------------------------------------------------------------- /hardcaml_of_verilog.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "Jane Street developers" 3 | authors: ["Jane Street Group, LLC"] 4 | homepage: "https://github.com/janestreet/hardcaml_of_verilog" 5 | bug-reports: "https://github.com/janestreet/hardcaml_of_verilog/issues" 6 | dev-repo: "git+https://github.com/janestreet/hardcaml_of_verilog.git" 7 | doc: "https://ocaml.janestreet.com/ocaml-core/latest/doc/hardcaml_of_verilog/index.html" 8 | license: "MIT" 9 | build: [ 10 | ["dune" "build" "-p" name "-j" jobs] 11 | ] 12 | depends: [ 13 | "ocaml" {>= "5.1.0"} 14 | "base" 15 | "core" 16 | "core_unix" 17 | "hardcaml" 18 | "hardcaml_verify" 19 | "jsonaf" 20 | "ppx_hardcaml" 21 | "ppx_jane" 22 | "ppx_jsonaf_conv" 23 | "stdio" 24 | "dune" {>= "3.17.0"} 25 | ] 26 | available: arch != "arm32" & arch != "x86_32" 27 | synopsis: "Convert Verilog to a Hardcaml design" 28 | description: " 29 | The opensource synthesis tool yosys is used to convert a verilog design to a JSON based 30 | netlist representation. This library can load the JSON netlist and build a hardcaml 31 | circuit. 32 | 33 | Code can also be generated to wrap the conversion process using Hardcaml interfaces. 34 | " 35 | -------------------------------------------------------------------------------- /port_verilog/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name hardcaml_port_verilog) 3 | (public_name hardcaml_of_verilog.port) 4 | (libraries core hardcaml hardcaml_of_verilog hardcaml_verify) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /port_verilog/hardcaml_port_verilog.ml: -------------------------------------------------------------------------------- 1 | include Port_verilog 2 | -------------------------------------------------------------------------------- /port_verilog/port_verilog.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Hardcaml 3 | open Hardcaml_of_verilog 4 | 5 | module Make (X : sig 6 | val verilog_design : Verilog_design.t 7 | val hardcaml_circuit : Circuit.t 8 | end) = 9 | struct 10 | module Verilog () = struct 11 | let netlist = Netlist.create X.verilog_design |> Or_error.ok_exn 12 | 13 | let verilog_circuit = 14 | Verilog_circuit.create netlist ~top_name:(Verilog_design.top_name X.verilog_design) 15 | |> Or_error.ok_exn 16 | ;; 17 | 18 | let circuit = Verilog_circuit.to_hardcaml_circuit verilog_circuit |> Or_error.ok_exn 19 | end 20 | 21 | module Verify () = struct 22 | module Verilog = Verilog () 23 | 24 | let verify ~instantiation_propositions ~register_propositions () = 25 | let hardcaml_circuit = X.hardcaml_circuit in 26 | let verilog_circuit = Verilog.circuit in 27 | let%bind.Or_error t = 28 | Hardcaml_verify.Sec.create 29 | ~instantiation_ports_match:Left_is_subset_of_right 30 | verilog_circuit 31 | hardcaml_circuit 32 | in 33 | let propositions = 34 | List.map instantiation_propositions ~f:(fun name -> 35 | Hardcaml_verify.Sec.find_instantiation_inputs_proposition t ~name 36 | |> Option.value_exn) 37 | @ List.map register_propositions ~f:(fun name -> 38 | Hardcaml_verify.Sec.find_register_inputs_proposition t ~name |> Option.value_exn) 39 | in 40 | match propositions with 41 | | [] -> Hardcaml_verify.Sec.circuits_equivalent t 42 | | _ -> Hardcaml_verify.Sec.equivalent propositions 43 | ;; 44 | 45 | let find_instantiation_ports instantiation_name = 46 | let open Hardcaml_of_verilog in 47 | let%bind.Or_error module_ = 48 | Netlist.find_module_by_name 49 | Verilog.netlist 50 | (Verilog_design.top_name X.verilog_design) 51 | in 52 | match 53 | List.find module_.cells ~f:(fun cell -> 54 | String.equal cell.instance_name instantiation_name) 55 | with 56 | | None -> Ok [] 57 | | Some cell -> Ok (List.map cell.inputs ~f:(fun port -> port.name)) 58 | ;; 59 | 60 | type port_result = 61 | | Qed 62 | | Different 63 | | No_port 64 | | Error 65 | [@@deriving sexp_of] 66 | 67 | let verify_instantiation_ports t ~instantiation_name ~port_name = 68 | let%bind.Or_error port_names = 69 | match port_name with 70 | | None -> find_instantiation_ports instantiation_name 71 | | Some port_name -> Ok [ port_name ] 72 | in 73 | Ok 74 | (List.map port_names ~f:(fun port_name -> 75 | ( port_name 76 | , match 77 | Hardcaml_verify.Sec.find_instantiation_input_port_proposition 78 | t 79 | ~instantiation_name 80 | ~port_name 81 | with 82 | | None -> No_port 83 | | Some proposition -> 84 | (match Hardcaml_verify.Sec.equivalent [ proposition ] with 85 | | Ok Unsat -> Qed 86 | | Ok (Sat _) -> Different 87 | | Error _ -> Error) ))) 88 | ;; 89 | 90 | let verify_top_ports t ~port_name = 91 | let open Hardcaml_of_verilog in 92 | let%bind.Or_error module_ = 93 | Netlist.find_module_by_name 94 | Verilog.netlist 95 | (Verilog_design.top_name X.verilog_design) 96 | in 97 | let port_names = 98 | match port_name with 99 | | None -> List.map module_.outputs ~f:(fun o -> o.name) 100 | | Some port_name -> [ port_name ] 101 | in 102 | Ok 103 | (List.map port_names ~f:(fun port_name -> 104 | ( port_name 105 | , match 106 | Hardcaml_verify.Sec.find_circuit_output_port_proposition t ~port_name 107 | with 108 | | None -> No_port 109 | | Some proposition -> 110 | (match Hardcaml_verify.Sec.equivalent [ proposition ] with 111 | | Ok Unsat -> Qed 112 | | Ok (Sat _) -> Different 113 | | Error _ -> Error) ))) 114 | ;; 115 | end 116 | 117 | let command_verify = 118 | Command.basic 119 | ~summary:"Perform verification to show equivalence" 120 | [%map_open.Command 121 | let () = return () 122 | and instantiation_propositions = 123 | flag 124 | "-instantiation" 125 | (listed string) 126 | ~doc:"PROP only check these instantiations" 127 | and register_propositions = 128 | flag "-register" (listed string) ~doc:"PROP only check these registers" 129 | in 130 | fun () -> 131 | let module Verify = Verify () in 132 | let result = 133 | Verify.verify ~instantiation_propositions ~register_propositions () 134 | in 135 | print_s 136 | [%message (result : Hardcaml_verify.Sec.Equivalence_result.t Or_error.t)]] 137 | ;; 138 | 139 | let command_verify_ports = 140 | Command.basic 141 | ~summary:"" 142 | [%map_open.Command 143 | let () = return () 144 | and instantiation_name = flag "-instantiation" (optional string) ~doc:"" 145 | and port_name = flag "-port" (optional string) ~doc:"" in 146 | fun () -> 147 | let module Verify = Verify () in 148 | let verify () = 149 | let hardcaml_circuit = X.hardcaml_circuit in 150 | let verilog_circuit = Verify.Verilog.circuit in 151 | let%bind.Or_error t = 152 | Hardcaml_verify.Sec.create 153 | ~instantiation_ports_match:Left_is_subset_of_right 154 | verilog_circuit 155 | hardcaml_circuit 156 | in 157 | match instantiation_name with 158 | | None -> Verify.verify_top_ports t ~port_name 159 | | Some instantiation_name -> 160 | Verify.verify_instantiation_ports t ~instantiation_name ~port_name 161 | in 162 | let result = verify () in 163 | print_s [%message (result : (string * Verify.port_result) list Or_error.t)]] 164 | ;; 165 | 166 | let command_print_verilog_netlist = 167 | Command.basic 168 | ~summary:"Print rtl as a netlist" 169 | [%map_open.Command 170 | let () = return () in 171 | fun () -> 172 | let module Verilog = Verilog () in 173 | let netlist () = Netlist.get_all_modules Verilog.netlist in 174 | print_s [%message (netlist () : Netlist.Module.t list Or_error.t)]] 175 | ;; 176 | 177 | let command_print_verilog_rtl = 178 | Command.basic 179 | ~summary:"Print verilog design as rtl" 180 | [%map_open.Command 181 | let () = return () in 182 | fun () -> 183 | let module Verilog = Verilog () in 184 | Rtl.print Verilog Verilog.circuit] 185 | ;; 186 | 187 | let command_list_verilog_ports = 188 | Command.basic 189 | ~summary:"Show the ports of the top level verilog design" 190 | [%map_open.Command 191 | let () = return () in 192 | fun () -> 193 | let module Verilog = Verilog () in 194 | let circuit = Verilog.circuit in 195 | let get_ports = 196 | List.map ~f:(fun signal -> 197 | Signal.names signal |> List.hd_exn, Signal.width signal) 198 | in 199 | let inputs = Circuit.inputs circuit |> get_ports in 200 | let outputs = Circuit.outputs circuit |> get_ports in 201 | print_s 202 | [%message (inputs : (string * int) list) (outputs : (string * int) list)]] 203 | ;; 204 | 205 | let command_list_verilog_instantiations = 206 | Command.basic 207 | ~summary:"List all instantiations in verilog netlist" 208 | [%map_open.Command 209 | let () = return () in 210 | fun () -> 211 | let module Verilog = Verilog () in 212 | let netlist = Verilog.netlist in 213 | let top = 214 | Netlist.find_module_by_name netlist (Verilog_design.top_name X.verilog_design) 215 | |> Or_error.ok_exn 216 | in 217 | let instantiation_names = 218 | List.map top.cells ~f:(fun cell -> cell.instance_name) 219 | in 220 | print_s [%message (instantiation_names : string list)]] 221 | ;; 222 | 223 | let command_print_hardcaml_rtl = 224 | Command.basic 225 | ~summary:"Print hardcaml circuit as verilog" 226 | [%map_open.Command 227 | let () = return () in 228 | fun () -> 229 | let circuit = X.hardcaml_circuit in 230 | Rtl.print Verilog circuit] 231 | ;; 232 | 233 | let command_list_hardcaml_ports = 234 | Command.basic 235 | ~summary:"Show the ports of the top level design" 236 | [%map_open.Command 237 | let () = return () in 238 | fun () -> 239 | let inputs = 240 | Circuit.inputs X.hardcaml_circuit 241 | |> List.map ~f:(fun s -> Signal.names s |> List.hd_exn, Signal.width s) 242 | in 243 | let outputs = 244 | Circuit.outputs X.hardcaml_circuit 245 | |> List.map ~f:(fun s -> Signal.names s |> List.hd_exn, Signal.width s) 246 | in 247 | print_s 248 | [%message (inputs : (string * int) list) (outputs : (string * int) list)]] 249 | ;; 250 | 251 | let command = 252 | Command.group 253 | ~summary:"" 254 | [ ( "verilog-design" 255 | , Command.group 256 | ~summary:"operations on the verilog rtl design" 257 | [ "netlist", command_print_verilog_netlist 258 | ; "verilog", command_print_verilog_rtl 259 | ; "ports", command_list_verilog_ports 260 | ; "instantiations", command_list_verilog_instantiations 261 | ] ) 262 | ; ( "hardcaml" 263 | , Command.group 264 | ~summary:"operations on the hardcaml design" 265 | [ "verilog", command_print_hardcaml_rtl 266 | ; "ports", command_list_hardcaml_ports 267 | ] ) 268 | ; ( "verify" 269 | , Command.group 270 | ~summary:"verification" 271 | [ "design", command_verify; "ports", command_verify_ports ] ) 272 | ] 273 | ;; 274 | end 275 | -------------------------------------------------------------------------------- /port_verilog/port_verilog.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module Make (X : sig 4 | val verilog_design : Hardcaml_of_verilog.Verilog_design.t 5 | val hardcaml_circuit : Hardcaml.Circuit.t 6 | end) : sig 7 | val command : Command.t 8 | end 9 | -------------------------------------------------------------------------------- /src/circuit_bus_map.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | module Bit = Netlist.Bit 3 | module Bus = Netlist.Bus 4 | module Bus_names = Netlist.Bus_names 5 | module Cell = Netlist.Cell 6 | module Port = Netlist.Port 7 | 8 | (* Operations we require from this data structure 9 | 10 | 1. add module inputs - signals are provided by the environment 11 | 2. add cell outputs - signal wires are created 12 | 3. construct a signal from above - for module outputs and cell inputs 13 | 4. get wire for cell output so it can be assign on instantiation 14 | 5. perform bus naming 15 | *) 16 | 17 | (* A [Select.t] represents a range of bits, taken from a [wire]. A bit vector is 18 | represented as a list of [Select.t]s (with the MSB at head of list). A bit can be 19 | concatented at the msb of the select list, and will be merged if possible. 20 | 21 | This allows us to recover busses from the netlist. *) 22 | module Select = struct 23 | type t = 24 | { signal : Hardcaml.Signal.t 25 | ; high : int 26 | ; low : int 27 | } 28 | [@@deriving sexp_of] 29 | 30 | (* [t] is sorted with the msb at the head of the list. *) 31 | let concat_top_bit t ~top = 32 | match t with 33 | | [] -> [ top ] 34 | | h :: t -> 35 | (* If the next bit is the next consequetive bit from the same signal, then merge 36 | into a larger select *) 37 | if Hardcaml.Signal.Type.Uid.equal 38 | (Hardcaml.Signal.uid h.signal) 39 | (Hardcaml.Signal.uid top.signal) 40 | && top.low = h.high + 1 41 | then { h with high = top.low } :: t 42 | else top :: h :: t 43 | ;; 44 | 45 | let vdd = { signal = Hardcaml.Signal.vdd; high = 0; low = 0 } 46 | let gnd = { signal = Hardcaml.Signal.gnd; high = 0; low = 0 } 47 | 48 | let to_signal selects = 49 | try 50 | let selects = 51 | List.map selects ~f:(fun select -> 52 | select.signal.Hardcaml.Signal.:[select.high, select.low]) 53 | in 54 | Ok (Hardcaml.Signal.concat_msb selects) 55 | with 56 | | e -> 57 | Or_error.error_s 58 | [%message "Unable to form signal from selects" (selects : t list) (e : exn)] 59 | ;; 60 | end 61 | 62 | module Module_input = struct 63 | type t = 64 | { input_signal : Hardcaml.Signal.t 65 | ; bus : Bus.t 66 | } 67 | [@@deriving sexp_of] 68 | end 69 | 70 | (* Associate circuit inputs (from the environment) with netlist module inputs. *) 71 | module Module_inputs = struct 72 | type t = Module_input.t Port.t list 73 | 74 | let circuit_input_map (circuit_inputs : Hardcaml.Signal.t Port.t list) = 75 | List.fold 76 | circuit_inputs 77 | ~init:(Ok (Map.empty (module String))) 78 | ~f:(fun map input -> 79 | let%bind.Or_error map in 80 | match Map.add map ~key:input.name ~data:input.value with 81 | | `Ok map -> Ok map 82 | | `Duplicate -> 83 | Or_error.error_s 84 | [%message 85 | "Duplicate circuit inputs provided" 86 | (circuit_inputs : Hardcaml.Signal.t Port.t list)]) 87 | ;; 88 | 89 | let module_input_ports 90 | (circuit_input_map : Hardcaml.Signal.t Map.M(String).t) 91 | (module_ports : Bus.t Port.t list) 92 | = 93 | List.map module_ports ~f:(fun port -> 94 | match Map.find circuit_input_map port.name with 95 | | Some input_signal -> 96 | Ok { port with value = { Module_input.input_signal; bus = port.value } } 97 | | None -> 98 | Or_error.error_s 99 | [%message 100 | "Unable to associate module port with supplied inputs" 101 | (port : Bus.t Port.t) 102 | (circuit_input_map : Hardcaml.Signal.t Map.M(String).t)]) 103 | |> Or_error.all 104 | ;; 105 | 106 | let create 107 | (circuit_inputs : Hardcaml.Signal.t Port.t list) 108 | (module_ports : Bus.t Port.t list) 109 | : t Or_error.t 110 | = 111 | let%bind.Or_error circuit_input_map = circuit_input_map circuit_inputs in 112 | module_input_ports circuit_input_map module_ports 113 | ;; 114 | end 115 | 116 | (* Key to map from a cell output port to it's signal *) 117 | module Cell_port = struct 118 | module T = struct 119 | type t = 120 | { cell_instance_name : string 121 | ; port_name : string 122 | } 123 | [@@deriving sexp_of, compare] 124 | end 125 | 126 | include T 127 | include Comparator.Make (T) 128 | end 129 | 130 | type t = 131 | { bit_to_select : Select.t Map.M(Int).t 132 | (* Map net indices to a single bit [Select.t] of the corresponding signal (input or cell 133 | output). *) 134 | ; cell_port_to_wire : Hardcaml.Signal.t Map.M(Cell_port).t 135 | (* Cell outputs indexed by port name and cell instantiation name *) 136 | ; bus_names : Bus_names.t (* Netlist bus names for recoving signal naming. *) 137 | } 138 | 139 | let add_bus_to_select_map map signal (port : Bus.t Port.t) = 140 | let rec f bit_index map (bits : Bus.t) = 141 | match bits with 142 | | [] -> Ok map 143 | | bit :: bits -> 144 | (match bit with 145 | | Vdd | Gnd | X -> 146 | Or_error.error_s 147 | [%message 148 | "Gnd, Vdd and X are not valid driver signals" 149 | (port : Bus.t Port.t) 150 | (signal : Hardcaml.Signal.t)] 151 | | Index index -> 152 | (match 153 | Map.add 154 | map 155 | ~key:index 156 | ~data:Select.{ signal; high = bit_index; low = bit_index } 157 | with 158 | | `Ok map -> f (bit_index + 1) map bits 159 | | `Duplicate -> 160 | Or_error.error_s [%message "Driver bit already defined" (index : int)])) 161 | in 162 | f 0 map port.value 163 | ;; 164 | 165 | let apply_names t signal bus = 166 | if List.is_empty (Hardcaml.Signal.names signal) 167 | then ( 168 | let names = Bus_names.find t.bus_names bus in 169 | List.fold names ~init:signal ~f:Hardcaml.Signal.( -- )) 170 | else signal 171 | ;; 172 | 173 | let add_module_input t input_signal (port : Bus.t Port.t) = 174 | let input_signal = apply_names t (Hardcaml.Signal.wireof input_signal) port.value in 175 | let%bind.Or_error bit_to_select = 176 | add_bus_to_select_map t.bit_to_select input_signal port 177 | in 178 | Ok { t with bit_to_select } 179 | ;; 180 | 181 | let add_cell_port map signal (cell : Cell.t) (port : _ Port.t) = 182 | match 183 | Map.add 184 | map 185 | ~key:Cell_port.{ cell_instance_name = cell.instance_name; port_name = port.name } 186 | ~data:signal 187 | with 188 | | `Ok map -> Ok map 189 | | `Duplicate -> 190 | Or_error.error_s 191 | [%message "Cell output port is duplicated" (port : Bus.t Port.t) (cell : Cell.t)] 192 | ;; 193 | 194 | let add_cell_output t (cell : Cell.t) (port : Bus.t Port.t) = 195 | match port.value with 196 | | [] -> Ok t 197 | | _ -> 198 | let cell_output_signal = 199 | apply_names t (Hardcaml.Signal.wire (List.length port.value)) port.value 200 | in 201 | let%bind.Or_error bit_to_select = 202 | add_bus_to_select_map t.bit_to_select cell_output_signal port 203 | in 204 | let%bind.Or_error cell_port_to_wire = 205 | add_cell_port t.cell_port_to_wire cell_output_signal cell port 206 | in 207 | Ok { t with bit_to_select; cell_port_to_wire } 208 | ;; 209 | 210 | let find_and_concat_bus_bit map selects (bit : Bit.t) = 211 | let%bind.Or_error selects in 212 | match bit with 213 | | Vdd -> Ok (Select.vdd :: selects) 214 | | Gnd -> Ok (Select.gnd :: selects) 215 | | X -> Ok (Select.gnd :: selects) 216 | | Index i -> 217 | (match Map.find map i with 218 | | None -> Or_error.error_s [%message "Failed to find net in bus map" (i : int)] 219 | | Some select -> Ok (Select.concat_top_bit selects ~top:select)) 220 | ;; 221 | 222 | let signal_of_bus t (bus : Bus.t Port.t) = 223 | let%bind.Or_error selects = 224 | List.fold bus.value ~init:(Ok []) ~f:(fun bus -> 225 | find_and_concat_bus_bit t.bit_to_select bus) 226 | in 227 | let%bind.Or_error signal = Select.to_signal selects in 228 | Ok { Port.name = bus.name; value = apply_names t signal bus.value } 229 | ;; 230 | 231 | let signal_of_bus_if_not_empty t (bus : Bus.t Port.t) = 232 | if List.is_empty bus.value then None else Some (signal_of_bus t bus) 233 | ;; 234 | 235 | let wire_of_cell_output t (cell : Cell.t) (port : Bus.t Port.t) = 236 | match port.value with 237 | | [] -> None 238 | | _ -> 239 | (match 240 | Map.find 241 | t.cell_port_to_wire 242 | Cell_port.{ cell_instance_name = cell.instance_name; port_name = port.name } 243 | with 244 | | Some signal -> Some (Ok { Port.name = port.name; value = signal }) 245 | | None -> 246 | Some 247 | (Or_error.error_s 248 | [%message 249 | "failed to find cell output port" (port : Bus.t Port.t) (cell : Cell.t)])) 250 | ;; 251 | 252 | let empty bus_names = 253 | { bit_to_select = Map.empty (module Int) 254 | ; cell_port_to_wire = Map.empty (module Cell_port) 255 | ; bus_names 256 | } 257 | ;; 258 | 259 | let create (module_ : Netlist.Module.t) ~circuit_inputs = 260 | let%bind.Or_error inputs = Module_inputs.create circuit_inputs module_.inputs in 261 | let bus_map = empty module_.bus_names in 262 | match 263 | List.fold inputs ~init:(Ok bus_map) ~f:(fun map port -> 264 | let%bind.Or_error map in 265 | add_module_input map port.value.input_signal { port with value = port.value.bus }) 266 | with 267 | | Error e -> Or_error.error_s [%message "adding module inputs" (e : Error.t)] 268 | | Ok bus_map -> 269 | (match 270 | List.fold module_.cells ~init:(Ok bus_map) ~f:(fun map cell -> 271 | List.fold cell.outputs ~init:map ~f:(fun map output -> 272 | let%bind.Or_error map in 273 | add_cell_output map cell output)) 274 | with 275 | | Error e -> Or_error.error_s [%message "adding cell outputs" (e : Error.t)] 276 | | Ok bus_map -> Ok bus_map) 277 | ;; 278 | -------------------------------------------------------------------------------- /src/circuit_bus_map.mli: -------------------------------------------------------------------------------- 1 | (** Internal module. See comment at the top of its implementation for more information. *) 2 | 3 | open Base 4 | module Bus = Netlist.Bus 5 | module Cell = Netlist.Cell 6 | module Port = Netlist.Port 7 | 8 | type t 9 | 10 | val create 11 | : Netlist.Module.t 12 | -> circuit_inputs:Hardcaml.Signal.t Port.t list 13 | -> t Or_error.t 14 | 15 | val signal_of_bus : t -> Bus.t Port.t -> Hardcaml.Signal.t Port.t Or_error.t 16 | 17 | val signal_of_bus_if_not_empty 18 | : t 19 | -> Bus.t Port.t 20 | -> Hardcaml.Signal.t Port.t Or_error.t Option.t 21 | 22 | val wire_of_cell_output 23 | : t 24 | -> Cell.t 25 | -> Bus.t Port.t 26 | -> Hardcaml.Signal.t Port.t Or_error.t Option.t 27 | -------------------------------------------------------------------------------- /src/circuit_to_json.ml: -------------------------------------------------------------------------------- 1 | open Hardcaml 2 | open Base 3 | open Yosys_netlist 4 | 5 | let print_s = Stdio.Out_channel.print_s 6 | 7 | let port_name signal = 8 | match Signal.names signal with 9 | | [ name ] -> name 10 | | _ -> raise_s [%message "Invalid circuit port name"] 11 | ;; 12 | 13 | let signal_op_to_string op = 14 | match (op : Signal.Type.signal_op) with 15 | | Signal_add -> "$add" 16 | | Signal_sub -> "$sub" 17 | | Signal_mulu -> "$mulu" 18 | | Signal_muls -> "$muls" 19 | | Signal_and -> "$and" 20 | | Signal_or -> "$or" 21 | | Signal_xor -> "$xor" 22 | | Signal_eq -> "$eq" 23 | | Signal_lt -> "$lt" 24 | ;; 25 | 26 | let create_module ~debug circuit = 27 | (* Create a set of signals we aren't rendering, so we should ignore them. *) 28 | let ignore_set = ref (Set.empty (module Signal.Type.Uid)) in 29 | Signal_graph.iter (Circuit.signal_graph circuit) ~f:(fun signal -> 30 | match signal with 31 | | Reg { register = { reset; clear; _ }; _ } -> 32 | Option.iter clear ~f:(fun { clear_to; _ } -> 33 | ignore_set := Set.add !ignore_set (Signal.uid clear_to)); 34 | Option.iter reset ~f:(fun { reset_to; _ } -> 35 | ignore_set := Set.add !ignore_set (Signal.uid reset_to)) 36 | | _ -> ()); 37 | (* Create a map of signal uids which will be outputs of instances, with a list of 38 | selects driven by that uid. This will be used to correctly assign signals to outputs 39 | of instances. *) 40 | let select_map = ref (Map.empty (module Signal.Type.Uid)) in 41 | Signal_graph.iter (Circuit.signal_graph circuit) ~f:(fun signal -> 42 | match signal with 43 | | Inst { signal_id; _ } -> 44 | select_map := Map.set !select_map ~key:signal_id.s_id ~data:[] 45 | | _ -> ()); 46 | Signal_graph.iter (Circuit.signal_graph circuit) ~f:(fun signal -> 47 | match signal with 48 | | Select { arg; signal_id; high; low } -> 49 | (* Only add it if it is driven by an Inst output. *) 50 | (match Map.find !select_map (Signal.uid arg) with 51 | | Some v -> 52 | select_map 53 | := Map.set 54 | !select_map 55 | ~key:(Signal.uid arg) 56 | ~data:((signal_id.s_id, high, low) :: v) 57 | | None -> ()) 58 | | _ -> ()); 59 | (* We create a map of signal_ids that when seen we want to replace the signal_id, this 60 | is used when dealing with wires. *) 61 | let driver_map = ref (Map.empty (module Signal.Type.Uid)) in 62 | Signal_graph.iter (Circuit.signal_graph circuit) ~f:(fun signal -> 63 | match signal with 64 | | Wire { signal_id; driver = Some driver } -> 65 | (match Map.add !driver_map ~key:signal_id.s_id ~data:(Signal.uid driver) with 66 | | `Ok new_map -> driver_map := new_map 67 | | _ -> ()) 68 | | _ -> ()); 69 | if debug 70 | then ( 71 | print_s [%message (!ignore_set : Set.M(Signal.Type.Uid).t)]; 72 | print_s [%message (!driver_map : Signal.Type.Uid.t Map.M(Signal.Type.Uid).t)]; 73 | print_s 74 | [%message 75 | (!select_map : (Signal.Type.Uid.t * int * int) list Map.M(Signal.Type.Uid).t)]); 76 | let rec get_driver s_id = 77 | match Map.find !driver_map s_id with 78 | | Some v -> get_driver v 79 | | None -> s_id 80 | in 81 | let bit_name_of_uid uid = Bit.Index (uid |> get_driver |> Signal.Type.Uid.to_int) in 82 | let bit_name_of_signal signal = 83 | Bit.Index (Signal.uid signal |> get_driver |> Signal.Type.Uid.to_int) 84 | in 85 | let bit_name_of_signal_opt = function 86 | | None -> bit_name_of_signal Signal.empty 87 | | Some signal -> bit_name_of_signal signal 88 | in 89 | let create_cells circuit = 90 | (* let default_attributes : attributes = 91 | * { src = ""; full_case = 0; parallel_case = 0; init = None; unused_bits = None } 92 | * in *) 93 | let default_cell = 94 | { Cell.V.module_name = "" 95 | ; parameters = [] 96 | ; port_directions = [] 97 | ; connections = [] 98 | ; hide_name = 0 99 | } 100 | in 101 | let cells = ref ([] : (string * Cell.V.t) list) in 102 | Signal_graph.iter (Circuit.signal_graph circuit) ~f:(fun signal -> 103 | if debug then Stdio.printf "%s\n" (Signal.to_string signal); 104 | let cell = 105 | let connections = 106 | List.map ~f:(fun (name, bits) -> Connection.{ name; value = bits }) 107 | in 108 | let port_dirns = 109 | List.map ~f:(fun (name, dirn) -> Port_direction.{ name; value = dirn }) 110 | in 111 | let open Direction in 112 | match signal with 113 | | Reg { d; signal_id; register } -> 114 | Some 115 | ( "$procdff$" ^ Signal.Type.Uid.to_string signal_id.s_id 116 | , { default_cell with 117 | module_name = "$our_dff" 118 | ; connections = 119 | [ "D", [ bit_name_of_signal d ] 120 | ; ( "CLR" 121 | , [ bit_name_of_signal_opt 122 | (Option.map register.clear ~f:(fun clear -> clear.clear)) 123 | ] ) 124 | ; ( "RST" 125 | , [ bit_name_of_signal_opt 126 | (Option.map register.reset ~f:(fun reset -> reset.reset)) 127 | ] ) 128 | ; "CLK", [ bit_name_of_signal register.clock.clock ] 129 | ; "CE", [ bit_name_of_signal_opt register.enable ] 130 | ; "Q", [ bit_name_of_uid signal_id.s_id ] 131 | ] 132 | |> connections 133 | ; port_directions = 134 | [ "CLK", Input 135 | ; "CE", Input 136 | ; "CLR", Input 137 | ; "RST", Input 138 | ; "D", Input 139 | ; "Q", Output 140 | ] 141 | |> port_dirns 142 | } ) 143 | | Cat { signal_id; args } -> 144 | Some 145 | ( "$mygate" ^ Signal.Type.Uid.to_string signal_id.s_id 146 | , { default_cell with 147 | module_name = "$cat" 148 | ; connections = 149 | [ "A", List.map args ~f:bit_name_of_signal 150 | ; "Y", [ bit_name_of_uid signal_id.s_id ] 151 | ] 152 | |> connections 153 | ; port_directions = [ "A", Input; "Y", Output ] |> port_dirns 154 | } ) 155 | | Empty -> None 156 | | Const { signal_id; constant } -> 157 | if Set.exists !ignore_set ~f:(Signal.Type.Uid.equal signal_id.s_id) 158 | then None 159 | else ( 160 | let name = 161 | "$" 162 | ^ (match Bits.width constant with 163 | | 1 -> if Bits.to_bool constant then "vdd" else "gnd" 164 | | _ -> "const " ^ Int.Hex.to_string (Bits.to_int_trunc constant)) 165 | ^ "_" 166 | ^ Signal.Type.Uid.to_string signal_id.s_id 167 | in 168 | Some 169 | ( name 170 | , { default_cell with 171 | module_name = name 172 | ; connections = [ "Y", [ bit_name_of_uid signal_id.s_id ] ] |> connections 173 | ; port_directions = [ "Y", Output ] |> port_dirns 174 | } )) 175 | | Not { arg; signal_id } -> 176 | Some 177 | ( "$not" ^ Signal.Type.Uid.to_string signal_id.s_id 178 | , { default_cell with 179 | module_name = "$inv" 180 | ; connections = 181 | [ "A", [ bit_name_of_signal arg ] 182 | ; "Y", [ bit_name_of_uid signal_id.s_id ] 183 | ] 184 | |> connections 185 | ; port_directions = [ "A", Input; "Y", Output ] |> port_dirns 186 | } ) 187 | | Wire _ -> None 188 | | Select { arg; signal_id; high; low } -> 189 | (* Don't draw the select if it is driven by an Inst. *) 190 | (match Map.find !select_map (Signal.uid arg) with 191 | | None -> 192 | Some 193 | (let select_name = 194 | "$select" 195 | ^ Signal.Type.Uid.to_string signal_id.s_id 196 | ^ "[" 197 | ^ Int.to_string high 198 | ^ ":" 199 | ^ Int.to_string low 200 | ^ "]" 201 | in 202 | ( select_name 203 | , { default_cell with 204 | module_name = select_name 205 | ; connections = 206 | [ "A", [ bit_name_of_signal arg ] 207 | ; "Y", [ bit_name_of_uid signal_id.s_id ] 208 | ] 209 | |> connections 210 | ; port_directions = [ "A", Input; "Y", Output ] |> port_dirns 211 | } )) 212 | | _ -> None) 213 | | Multiport_mem { signal_id; write_ports; _ } -> 214 | Some 215 | ( "$memory" ^ Signal.Type.Uid.to_string signal_id.s_id 216 | , { default_cell with 217 | module_name = "$multiportmem" 218 | ; connections = 219 | List.concat 220 | Array.( 221 | mapi write_ports ~f:(fun i a -> 222 | [ "WR_DATA" ^ Int.to_string i, [ bit_name_of_signal a.write_data ] 223 | ; "WR_EN" ^ Int.to_string i, [ bit_name_of_signal a.write_enable ] 224 | ; ( "WR_ADDR" ^ Int.to_string i 225 | , [ bit_name_of_signal a.write_address ] ) 226 | ; "WR_CLK" ^ Int.to_string i, [ bit_name_of_signal a.write_clock ] 227 | ]) 228 | |> to_list) 229 | @ [ "A", [ bit_name_of_uid signal_id.s_id ] ] 230 | |> connections 231 | ; port_directions = 232 | List.concat 233 | Array.( 234 | mapi write_ports ~f:(fun i _ -> 235 | [ "WR_DATA" ^ Int.to_string i, Input 236 | ; "WR_EN" ^ Int.to_string i, Input 237 | ; "WR_ADDR" ^ Int.to_string i, Input 238 | ; "WR_CLK" ^ Int.to_string i, Input 239 | ]) 240 | |> to_list) 241 | @ [ "A", Input ] 242 | |> port_dirns 243 | } ) 244 | | Mem_read_port { signal_id; _ } -> 245 | Some 246 | ( "$mem_read_port" ^ Signal.Type.Uid.to_string signal_id.s_id 247 | , { default_cell with 248 | module_name = "$memreadport" 249 | ; connections = [ "A", [ bit_name_of_uid signal_id.s_id ] ] |> connections 250 | ; port_directions = [ "A", Input ] |> port_dirns 251 | } ) 252 | | Op2 { signal_id; op; arg_a; arg_b } -> 253 | Some 254 | ( "$gate" ^ Signal.Type.Uid.to_string signal_id.s_id 255 | , { default_cell with 256 | module_name = signal_op_to_string op 257 | ; connections = 258 | [ "A", [ bit_name_of_signal arg_a ] 259 | ; "B", [ bit_name_of_signal arg_b ] 260 | ; "Y", [ bit_name_of_uid signal_id.s_id ] 261 | ] 262 | |> connections 263 | ; port_directions = [ "A", Input; "B", Input; "Y", Output ] |> port_dirns 264 | } ) 265 | | Mux { signal_id; select; cases } -> 266 | Some 267 | ( "$mux" ^ Signal.Type.Uid.to_string signal_id.s_id 268 | , { default_cell with 269 | module_name = "$our_mux" 270 | ; connections = 271 | List.mapi cases ~f:(fun i a -> 272 | "A" ^ Int.to_string i, [ bit_name_of_signal a ]) 273 | @ [ "S", [ bit_name_of_signal select ] ] 274 | @ [ "Y", [ bit_name_of_uid signal_id.s_id ] ] 275 | |> connections 276 | ; port_directions = 277 | List.mapi cases ~f:(fun i _ -> "A" ^ Int.to_string i, Input) 278 | @ [ "S", Input ] 279 | @ [ "Y", Output ] 280 | |> port_dirns 281 | } ) 282 | | Cases { signal_id; select; cases; default } -> 283 | Some 284 | ( "$cases" ^ Signal.Type.Uid.to_string signal_id.s_id 285 | , { default_cell with 286 | module_name = "$our_cases" 287 | ; connections = 288 | (List.mapi cases ~f:(fun i (match_with, value) -> 289 | [ "M" ^ Int.to_string i, [ bit_name_of_signal match_with ] 290 | ; "V" ^ Int.to_string i, [ bit_name_of_signal value ] 291 | ]) 292 | |> List.concat) 293 | @ [ "S", [ bit_name_of_signal select ] 294 | ; "D", [ bit_name_of_signal default ] 295 | ; "Y", [ bit_name_of_uid signal_id.s_id ] 296 | ] 297 | |> connections 298 | ; port_directions = 299 | (List.mapi cases ~f:(fun i _ -> 300 | [ "M" ^ Int.to_string i, Input; "V" ^ Int.to_string i, Input ]) 301 | |> List.concat) 302 | @ [ "S", Input; "D", Input; "Y", Output ] 303 | |> port_dirns 304 | } ) 305 | | Inst { signal_id; instantiation; _ } -> 306 | (* Get the list of selects this instance drives. *) 307 | let selects = Map.find_exn !select_map signal_id.s_id in 308 | Some 309 | ( "$mygate" ^ Signal.Type.Uid.to_string signal_id.s_id 310 | , { default_cell with 311 | module_name = "$inst_" ^ instantiation.inst_instance 312 | ; connections = 313 | List.mapi instantiation.inst_inputs ~f:(fun _i (n, s) -> 314 | n, [ bit_name_of_signal s ]) 315 | @ List.filter_map 316 | instantiation.inst_outputs 317 | ~f:(fun (n, (_width, o_lo)) -> 318 | (* Try match each output with a select based on its hi and lo. *) 319 | match List.find selects ~f:(fun (_id, _hi, lo) -> o_lo = lo) with 320 | | Some (signal_id, _, _) -> Some (n, [ bit_name_of_uid signal_id ]) 321 | | None -> None) 322 | |> connections 323 | ; port_directions = 324 | List.mapi instantiation.inst_inputs ~f:(fun _i (n, _s) -> n, Input) 325 | @ List.filter_map 326 | instantiation.inst_outputs 327 | ~f:(fun (n, (_width, o_lo)) -> 328 | match List.find selects ~f:(fun (_id, _hi, lo) -> o_lo = lo) with 329 | | Some _ -> Some (n, Output) 330 | | None -> None) 331 | |> port_dirns 332 | } ) 333 | in 334 | Option.iter cell ~f:(fun cell -> cells := cell :: !cells)); 335 | !cells 336 | in 337 | let inputs = 338 | List.map (Circuit.inputs circuit) ~f:(fun input -> 339 | Port. 340 | { name = port_name input 341 | ; value = { direction = Input; bits = [ bit_name_of_signal input ] } 342 | }) 343 | in 344 | let outputs = 345 | List.map (Circuit.outputs circuit) ~f:(fun output -> 346 | Port. 347 | { name = port_name output 348 | ; value = { direction = Output; bits = [ bit_name_of_signal output ] } 349 | }) 350 | in 351 | { Module.name = Circuit.name circuit 352 | ; value = 353 | { ports = inputs @ outputs 354 | ; cells = 355 | List.map (create_cells circuit) ~f:(fun (name, cell) -> 356 | { Cell.name; value = cell }) 357 | ; netnames = [] 358 | } 359 | } 360 | ;; 361 | 362 | let convert ?(debug = false) circuit = 363 | { creator = "hardcaml"; modules = [ create_module circuit ~debug ] } 364 | ;; 365 | -------------------------------------------------------------------------------- /src/circuit_to_json.mli: -------------------------------------------------------------------------------- 1 | (** Takes in a Hardcaml circuit and transforms it to a json file that can be read and 2 | rendered by netlistsvg. *) 3 | 4 | open Base 5 | 6 | val convert : ?debug:bool -> Hardcaml.Circuit.t -> Yosys_netlist.t 7 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name hardcaml_of_verilog) 3 | (public_name hardcaml_of_verilog) 4 | (libraries base hardcaml core_unix.filename_unix jsonaf stdio unix) 5 | (preprocess 6 | (pps ppx_jane ppx_jsonaf_conv ppx_hardcaml))) 7 | -------------------------------------------------------------------------------- /src/hardcaml_of_verilog.ml: -------------------------------------------------------------------------------- 1 | module Circuit_to_json = Circuit_to_json 2 | module Netlist = Netlist 3 | module Ocaml_module = Ocaml_module 4 | module Pass = Pass 5 | module Verilog_circuit = Verilog_circuit 6 | module Verilog_design = Verilog_design 7 | module With_interface = With_interface 8 | 9 | module Expert = struct 10 | module Synthesize = Synthesize 11 | module Yosys_netlist = Yosys_netlist 12 | end 13 | -------------------------------------------------------------------------------- /src/lvt.ml: -------------------------------------------------------------------------------- 1 | (* 2 | Multiport memories for Hardcaml 3 | =============================== 4 | 5 | The basic memory primitive provide by Hardcaml has one write (wr) and 6 | one read (rd) port. The write is synchronous and the read is asynchronous. 7 | By adding a register to either the read address or output data we can 8 | generate standard read-before-write and write-before-read synchronous 9 | memories. The read and write clocks can be from different domains. 10 | 11 | A simple way to build a multi-port memory is out of simple registers 12 | This is, of course, very inefficient. One restriction that 13 | still exists is that each write port must be from the same clock 14 | domain. I (think) the reads ports could potentially be in differing 15 | clock domains. 16 | 17 | LVT 18 | === 19 | 20 | To do a bit better we can instead build multi-port memories using 21 | a Live Value Table (LVT). The idea here is in 3 steps; 22 | 23 | 1] To make N rd ports, we replicate a 1 rd ram N times each written 24 | with the same data. Note each replicated RAM will contain exactly 25 | the same data. The replication provides N access ports to this data. 26 | Call this memory_nrd. 27 | 28 | 2] To make M wr ports we initially replicate memory_nrd M times. 29 | Each write port is connected to one memory_nrd instance. Note that 30 | each memory_nrd bank will this time contain different data. 31 | We now have M * N ram outputs to select between to for the N read 32 | ports. 33 | 34 | 3] Build the live value table. This tracks the bank which was most 35 | recently written for each address in the RAM. This is built as 36 | a multi-port memory itself, specifically using the simple register 37 | scheme described before. The outputs of the LVT (one for each read 38 | port) selects the bank built in step 2 that contains the most 39 | recently written value for a particular address. 40 | 41 | Consider 2 read, 4 write ports on a 256 element x 32 bit memory. 42 | Using the pure register scheme we will need to generate 256x32 43 | register bits, write port selection logic at the input to each 44 | register, and 2 256x32 muxes to select the read data. 45 | 46 | With the LVT scheme we still need a register based multiport 47 | memory - in this case 2 read, 4 write ports on a 256 element x 2 bit 48 | memory. Note the change here - we went from a 32 bit memory (to 49 | store the data) to a 2 bit memory (to store the index of the latest 50 | write bank ie it's of width log2(number of write ports). In this 51 | case we have save approx 16x logic resources. 52 | 53 | Of course we also need 2*4 256 x 32 memories (with 1 read and 1 write 54 | port each) to store the data. 55 | *) 56 | 57 | open! Base 58 | open Hardcaml 59 | open Signal 60 | 61 | module type Config = sig 62 | val abits : int 63 | val dbits : int 64 | val size : int 65 | end 66 | 67 | module Wr = struct 68 | type 'a t = 69 | { we : 'a 70 | ; wa : 'a 71 | ; d : 'a 72 | } 73 | [@@deriving hardcaml] 74 | end 75 | 76 | module Rd = struct 77 | type 'a t = 78 | { re : 'a 79 | ; ra : 'a 80 | } 81 | [@@deriving hardcaml] 82 | end 83 | 84 | (* fallthrough = wbr (write before read) *) 85 | type mode = 86 | [ `async_rbw 87 | | `async_wbr 88 | | `sync_rbw 89 | | `sync_wbr 90 | ] 91 | 92 | let is_sync = function 93 | | `sync_wbr | `sync_rbw -> true 94 | | _ -> false 95 | ;; 96 | 97 | let is_async m = not (is_sync m) 98 | 99 | let is_rbw = function 100 | | `sync_rbw | `async_rbw -> true 101 | | _ -> false 102 | ;; 103 | 104 | let is_wbr m = not (is_rbw m) 105 | 106 | type wr_port = 107 | { wr : t Wr.t 108 | ; ram_spec : Reg_spec.t 109 | ; reg_spec : Reg_spec.t 110 | } 111 | 112 | type rd_port = 113 | { rd : t Rd.t 114 | ; reg_spec : Reg_spec.t 115 | ; mode : mode 116 | } 117 | 118 | module Ports (C : Config) = struct 119 | module Wr = struct 120 | include Wr 121 | 122 | let bits = { we = 1; wa = C.abits; d = C.dbits } 123 | let port_names_and_widths = zip port_names bits 124 | end 125 | 126 | module Rd = struct 127 | include Rd 128 | 129 | let bits = { re = 1; ra = C.abits } 130 | let port_names_and_widths = zip port_names bits 131 | end 132 | end 133 | 134 | module Multiport_regs (C : Config) = struct 135 | (* async read memories with multiple read and write ports, implemented as registers *) 136 | 137 | open C 138 | include Ports (C) 139 | open Wr 140 | open Rd 141 | 142 | let pri = 143 | tree ~arity:2 ~f:(function 144 | | [ a ] -> a 145 | | [ (s0, d0); (s1, d1) ] -> s1 |: s0, mux2 s1 d1 d0 146 | | _ -> empty, empty) 147 | ;; 148 | 149 | let reg_we_enable ~we ~wa = 150 | (binary_to_onehot wa).:[size - 1, 0] &: mux2 we (ones size) (zero size) 151 | ;; 152 | 153 | let memory_nwr_array ~(wr : wr_port array) = 154 | let reg_spec = wr.(0).reg_spec in 155 | let wr = List.map ~f:(fun wr -> wr.wr) @@ Array.to_list wr in 156 | let we1h = List.map ~f:(fun wr -> reg_we_enable ~we:wr.we ~wa:wr.wa) wr in 157 | Array.to_list 158 | @@ Array.init size ~f:(fun elt -> 159 | let wed = List.map2_exn ~f:(fun we1h wr -> we1h.:(elt), wr.d) we1h wr in 160 | let we, d = pri wed in 161 | (* last d with write enable set *) 162 | let r = reg reg_spec ~enable:we d in 163 | we, d, r) 164 | ;; 165 | 166 | (* n write, n read ports *) 167 | let memory ~(wr : wr_port array) ~(rd : rd_port array) = 168 | let base = memory_nwr_array ~wr in 169 | Array.init (Array.length rd) ~f:(fun i -> 170 | let reg_spec = rd.(i).reg_spec in 171 | let mr = List.map ~f:(fun (we, d, r) -> mux2 we d r) base in 172 | let r = List.map ~f:(fun (_, _, r) -> r) base in 173 | match rd.(i).mode with 174 | | `async_wbr -> mux rd.(i).rd.ra mr 175 | | `async_rbw -> mux rd.(i).rd.ra r 176 | | `sync_wbr -> mux (reg reg_spec ~enable:rd.(i).rd.re rd.(i).rd.ra) r 177 | | `sync_rbw -> reg reg_spec ~enable:rd.(i).rd.re (mux rd.(i).rd.ra r)) 178 | ;; 179 | end 180 | 181 | module Make (C : Config) = struct 182 | include Ports (C) 183 | open Wr 184 | open Rd 185 | 186 | (* compatibility shim *) 187 | let memory ram_spec size ~we ~wa ~d ~ra = 188 | memory 189 | size 190 | ~write_port: 191 | { write_clock = Reg_spec.clock ram_spec 192 | ; write_enable = we 193 | ; write_address = wa 194 | ; write_data = d 195 | } 196 | ~read_address:ra 197 | ;; 198 | 199 | let memory_1rd ~wr ~rd = 200 | let ram_spec = wr.ram_spec in 201 | let reg_spec = rd.reg_spec in 202 | let mode = rd.mode in 203 | let wr, rd = wr.wr, rd.rd in 204 | match mode with 205 | | `sync_rbw -> 206 | reg 207 | reg_spec 208 | ~enable:rd.re 209 | (memory ram_spec C.size ~we:wr.we ~wa:wr.wa ~d:wr.d ~ra:rd.ra) 210 | | `sync_wbr -> 211 | memory 212 | ram_spec 213 | C.size 214 | ~we:wr.we 215 | ~wa:wr.wa 216 | ~d:wr.d 217 | ~ra:(reg reg_spec ~enable:rd.re rd.ra) 218 | | `async_rbw -> memory ram_spec C.size ~we:wr.we ~wa:wr.wa ~d:wr.d ~ra:rd.ra 219 | | `async_wbr -> 220 | mux2 221 | (wr.we &: (wr.wa ==: rd.ra)) 222 | wr.d 223 | (memory ram_spec C.size ~we:wr.we ~wa:wr.wa ~d:wr.d ~ra:rd.ra) 224 | ;; 225 | 226 | let memory_nrd ~wr ~rd = 227 | let nrd = Array.length rd in 228 | Array.init nrd ~f:(fun i -> memory_1rd ~wr ~rd:rd.(i)) 229 | ;; 230 | 231 | let memory ~wr ~rd = 232 | let nwr, nrd = Array.length wr, Array.length rd in 233 | (* create the live value table *) 234 | let module Lvt_cfg = struct 235 | let abits = C.abits 236 | let dbits = Int.ceil_log2 nwr 237 | let size = C.size 238 | end 239 | in 240 | let module Lvt = Multiport_regs (Lvt_cfg) in 241 | let lvt = 242 | if nwr = 1 243 | then [||] 244 | else ( 245 | let lvt_wr = 246 | Array.init nwr ~f:(fun i -> 247 | { (wr.(i)) with 248 | wr = { wr.(i).wr with d = of_int_trunc ~width:Lvt_cfg.dbits i } 249 | }) 250 | in 251 | Lvt.memory ~wr:lvt_wr ~rd) 252 | in 253 | (* create the memory banks *) 254 | let mem = Array.init nwr ~f:(fun i -> memory_nrd ~wr:wr.(i) ~rd) in 255 | (* select the correct memory bank *) 256 | Array.init nrd ~f:(fun rd -> 257 | let mem = Array.init nwr ~f:(fun wr -> mem.(wr).(rd)) in 258 | if nwr = 1 then mem.(0) else mux lvt.(rd) (Array.to_list mem)) 259 | ;; 260 | end 261 | 262 | module Make_wren (C : Config) = struct 263 | module Wr = struct 264 | include Wr 265 | 266 | let bits = { we = C.dbits; wa = C.abits; d = C.dbits } 267 | let port_names_and_widths = zip port_names bits 268 | end 269 | 270 | module Rd = struct 271 | include Rd 272 | 273 | let bits = { re = 1; ra = C.abits } 274 | let port_names_and_widths = zip port_names bits 275 | end 276 | 277 | module L = Make (C) 278 | 279 | let get_layout wrnets = 280 | let runs list = 281 | let rec f acc prev l = 282 | match prev, l with 283 | | None, [] -> [] 284 | | None, h :: t -> f acc (Some (h, 1)) t 285 | | Some (prev, run), [] -> List.rev ((prev, run) :: acc) 286 | | Some (prev, run), h :: t -> 287 | if Poly.equal prev h 288 | then f acc (Some (prev, run + 1)) t 289 | else f ((prev, run) :: acc) (Some (h, 1)) t 290 | in 291 | f [] None list 292 | in 293 | let transpose a = 294 | let i0 = Array.length a in 295 | let i1 = Array.length a.(0) in 296 | Array.init i1 ~f:(fun i1 -> Array.init i0 ~f:(fun i0 -> a.(i0).(i1))) 297 | in 298 | let rec starts pos = function 299 | | [] -> [] 300 | | (h, r) :: t -> (h, pos, r) :: starts (pos + r) t 301 | in 302 | starts 0 @@ runs @@ Array.to_list @@ transpose wrnets 303 | ;; 304 | 305 | let memory ~layout = 306 | let layout = get_layout layout in 307 | let memory ~wr ~rd = 308 | let nrd = Array.length rd in 309 | let concat l = 310 | Array.init nrd ~f:(fun i -> concat_lsb @@ List.map ~f:(fun x -> x.(i)) l) 311 | in 312 | concat 313 | @@ List.map 314 | ~f:(fun (_, n, bits) -> 315 | let sel_wr wr = 316 | { wr with 317 | wr = 318 | { wr.wr with 319 | Wr.we = wr.wr.Wr.we.:[n, n] 320 | ; d = wr.wr.Wr.d.:[n + bits - 1, n] 321 | } 322 | } 323 | in 324 | let wr = Array.map ~f:sel_wr wr in 325 | L.memory ~wr ~rd) 326 | layout 327 | in 328 | memory 329 | ;; 330 | end 331 | -------------------------------------------------------------------------------- /src/lvt.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | open Hardcaml 3 | open Signal 4 | 5 | module type Config = sig 6 | val abits : int 7 | val dbits : int 8 | val size : int 9 | end 10 | 11 | module Wr : sig 12 | type 'a t = 13 | { we : 'a 14 | ; wa : 'a 15 | ; d : 'a 16 | } 17 | [@@deriving hardcaml] 18 | end 19 | 20 | module Rd : sig 21 | type 'a t = 22 | { re : 'a 23 | ; ra : 'a 24 | } 25 | [@@deriving hardcaml] 26 | end 27 | 28 | type mode = 29 | [ `async_rbw 30 | | `async_wbr 31 | | `sync_rbw 32 | | `sync_wbr 33 | ] 34 | 35 | val is_async : mode -> bool 36 | val is_sync : mode -> bool 37 | val is_rbw : mode -> bool 38 | val is_wbr : mode -> bool 39 | 40 | type wr_port = 41 | { wr : t Wr.t 42 | ; ram_spec : Reg_spec.t 43 | ; reg_spec : Reg_spec.t 44 | } 45 | 46 | type rd_port = 47 | { rd : t Rd.t 48 | ; reg_spec : Reg_spec.t 49 | ; mode : mode 50 | } 51 | 52 | module Multiport_regs (C : Config) : sig 53 | module Wr : module type of Wr with type 'a t = 'a Wr.t 54 | module Rd : module type of Rd with type 'a t = 'a Rd.t 55 | 56 | val memory : wr:wr_port array -> rd:rd_port array -> t array 57 | end 58 | 59 | module Make (C : Config) : sig 60 | module Wr : module type of Wr with type 'a t = 'a Wr.t 61 | module Rd : module type of Rd with type 'a t = 'a Rd.t 62 | 63 | val memory : wr:wr_port array -> rd:rd_port array -> t array 64 | end 65 | 66 | module Make_wren (C : Config) : sig 67 | module Wr : module type of Wr with type 'a t = 'a Wr.t 68 | module Rd : module type of Rd with type 'a t = 'a Rd.t 69 | 70 | val memory : layout:_ array array -> wr:wr_port array -> rd:rd_port array -> t array 71 | end 72 | -------------------------------------------------------------------------------- /src/netlist.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | module Bit = Yosys_netlist.Bit 3 | 4 | module Bus = struct 5 | module T = struct 6 | type t = Bit.t list [@@deriving sexp_of, compare] 7 | end 8 | 9 | include T 10 | include Comparator.Make (T) 11 | end 12 | 13 | module Parameter = struct 14 | type t = Hardcaml.Parameter.t [@@deriving sexp_of] 15 | 16 | let of_yosys_netlist (p : Yosys_netlist.Parameter.t) = 17 | match p.value with 18 | | Int i -> Hardcaml.Parameter.create ~name:p.name ~value:(Int i) 19 | | String s -> Hardcaml.Parameter.create ~name:p.name ~value:(String s) 20 | ;; 21 | end 22 | 23 | module Port = struct 24 | type 'a t = 25 | { name : string 26 | ; value : 'a 27 | } 28 | [@@deriving sexp_of, fields ~getters] 29 | 30 | let find (ports : _ t list) name = 31 | let rec f = function 32 | | [] -> 33 | Or_error.error_s 34 | [%message "Could not find port" (name : string) (ports : _ t list)] 35 | | h :: t -> if String.equal h.name name then Ok h else f t 36 | in 37 | f ports 38 | ;; 39 | 40 | let find_exn ports name = find ports name |> Or_error.ok_exn 41 | end 42 | 43 | module Cell = struct 44 | type t = 45 | { module_name : string 46 | ; instance_name : string 47 | ; parameters : Parameter.t list 48 | ; inputs : Bus.t Port.t list 49 | ; outputs : Bus.t Port.t list 50 | } 51 | [@@deriving sexp_of] 52 | 53 | let partition_by_port_direction 54 | (cell : Yosys_netlist.Cell.t) 55 | (directions : Yosys_netlist.Direction.t Map.M(String).t) 56 | = 57 | let rec f inputs outputs (connections : Yosys_netlist.Connection.t list) = 58 | match connections with 59 | | [] -> Ok (inputs, outputs) 60 | | conn :: conns -> 61 | (match Map.find directions conn.name with 62 | | None -> 63 | Or_error.error_s 64 | [%message 65 | "No port direction specified" 66 | (conn : Yosys_netlist.Connection.t) 67 | (cell : Yosys_netlist.Cell.t)] 68 | | Some Input -> 69 | f ({ Port.name = conn.name; value = conn.value } :: inputs) outputs conns 70 | | Some Output -> 71 | f inputs ({ Port.name = conn.name; value = conn.value } :: outputs) conns) 72 | in 73 | f [] [] cell.value.connections 74 | ;; 75 | 76 | let of_yosys_netlist (cell : Yosys_netlist.Cell.t) = 77 | let%bind.Or_error directions = 78 | List.fold 79 | cell.value.port_directions 80 | ~init:(Ok (Map.empty (module String))) 81 | ~f:(fun map dirn -> 82 | let%bind.Or_error map in 83 | match Map.add map ~key:dirn.name ~data:dirn.value with 84 | | `Ok map -> Ok map 85 | | `Duplicate -> 86 | Or_error.error_s 87 | [%message 88 | "Port direction specified more than once" 89 | (dirn : Yosys_netlist.Port_direction.t) 90 | (cell : Yosys_netlist.Cell.t)]) 91 | in 92 | let%bind.Or_error inputs, outputs = partition_by_port_direction cell directions in 93 | Ok 94 | { module_name = cell.value.module_name 95 | ; instance_name = cell.name 96 | ; parameters = List.map cell.value.parameters ~f:Parameter.of_yosys_netlist 97 | ; inputs 98 | ; outputs 99 | } 100 | ;; 101 | end 102 | 103 | (* Map of bus names from net indexes. *) 104 | module Bus_names = struct 105 | type t = string list Map.M(Bus).t [@@deriving sexp_of] 106 | 107 | let add_to map ~key ~data = 108 | match Map.find map key with 109 | | None -> 110 | (* this wont raise, as we just check the key doesn't exist. *) 111 | Map.add_exn map ~key ~data:[ data ] 112 | | Some lst -> (* replace the key *) Map.set map ~key ~data:(data :: lst) 113 | ;; 114 | 115 | let create (netnames : Yosys_netlist.Netname.t list) : t = 116 | List.fold 117 | netnames 118 | ~init:(Map.empty (module Bus)) 119 | ~f:(fun map netname -> 120 | if netname.value.hide_name = 1 121 | then map 122 | else add_to map ~key:netname.value.bits ~data:netname.name) 123 | ;; 124 | 125 | let find t bus = 126 | match Map.find t bus with 127 | | None -> [] 128 | | Some l -> l 129 | ;; 130 | end 131 | 132 | module Module = struct 133 | type t = 134 | { name : string 135 | ; inputs : Bus.t Port.t list 136 | ; outputs : Bus.t Port.t list 137 | ; cells : Cell.t list 138 | ; bus_names : Bus_names.t 139 | } 140 | [@@deriving sexp_of] 141 | 142 | (* Partition ports of module into inputs and outputs *) 143 | let partition_module_ports (module_ : Yosys_netlist.Module.t) = 144 | let inputs, outputs = 145 | List.partition_tf module_.value.ports ~f:(fun p -> 146 | Yosys_netlist.Direction.(equal Input p.value.direction)) 147 | in 148 | let to_ports ports = 149 | List.map 150 | (ports : Yosys_netlist.Port.t list) 151 | ~f:(fun p -> { Port.name = p.name; value = p.value.bits }) 152 | in 153 | to_ports inputs, to_ports outputs 154 | ;; 155 | 156 | let of_yosys_netlist name (t : Yosys_netlist.Module.t) = 157 | let inputs, outputs = partition_module_ports t in 158 | let%bind.Or_error cells = 159 | List.map t.value.cells ~f:Cell.of_yosys_netlist |> Or_error.all 160 | in 161 | Ok { name; inputs; outputs; cells; bus_names = Bus_names.create t.value.netnames } 162 | ;; 163 | 164 | let sanitize_instance_names module_ = 165 | { module_ with 166 | cells = 167 | List.mapi module_.cells ~f:(fun index cell -> 168 | { cell with instance_name = "the_inst_" ^ Int.to_string index }) 169 | } 170 | ;; 171 | end 172 | 173 | type t = (string * Module.t Or_error.t Lazy.t) list 174 | 175 | let sexp_of_t t = [%sexp_of: string list] (List.map t ~f:fst) 176 | 177 | let of_yosys_netlist (t : Yosys_netlist.t) = 178 | Or_error.try_with (fun () -> 179 | List.map t.modules ~f:(fun module_ -> 180 | module_.name, lazy (Module.of_yosys_netlist module_.name module_))) 181 | ;; 182 | 183 | let find_module_by_name t name = 184 | match List.Assoc.find t ~equal:String.equal name with 185 | | None -> Or_error.error_s [%message "Failed to find requested module" (name : string)] 186 | | Some module_ -> Lazy.force module_ 187 | ;; 188 | 189 | let get_all_modules t = 190 | List.map t ~f:(fun (_, module_) -> Lazy.force module_) |> Or_error.all 191 | ;; 192 | 193 | let create ?verbose ?passes verilog_design = 194 | let%bind.Or_error netlist = 195 | Synthesize.to_yosys_netlist ?verbose ?passes verilog_design 196 | in 197 | of_yosys_netlist netlist 198 | ;; 199 | -------------------------------------------------------------------------------- /src/netlist.mli: -------------------------------------------------------------------------------- 1 | (** Netlist representing a verilog design synthesized with yosys. 2 | 3 | The conversion is done lazily when a module is referenced. *) 4 | 5 | open Base 6 | module Bit = Yosys_netlist.Bit 7 | 8 | module Bus : sig 9 | type t = Bit.t list [@@deriving sexp_of] 10 | 11 | include Comparator.S with type t := t 12 | end 13 | 14 | module Parameter : sig 15 | type t = Hardcaml.Parameter.t [@@deriving sexp_of] 16 | end 17 | 18 | module Port : sig 19 | type 'a t = 20 | { name : string 21 | ; value : 'a 22 | } 23 | [@@deriving sexp_of, fields ~getters] 24 | 25 | val find : 'a t list -> string -> 'a t Or_error.t 26 | val find_exn : 'a t list -> string -> 'a t 27 | end 28 | 29 | module Cell : sig 30 | type t = 31 | { module_name : string 32 | ; instance_name : string 33 | ; parameters : Parameter.t list 34 | ; inputs : Bus.t Port.t list 35 | ; outputs : Bus.t Port.t list 36 | } 37 | [@@deriving sexp_of] 38 | end 39 | 40 | module Bus_names : sig 41 | type t [@@deriving sexp_of] 42 | 43 | val create : Yosys_netlist.Netname.t list -> t 44 | val find : t -> Bus.t -> string list 45 | end 46 | 47 | module Module : sig 48 | type t = 49 | { name : string 50 | ; inputs : Bus.t Port.t list 51 | ; outputs : Bus.t Port.t list 52 | ; cells : Cell.t list 53 | ; bus_names : Bus_names.t 54 | } 55 | [@@deriving sexp_of] 56 | 57 | val sanitize_instance_names : t -> t 58 | end 59 | 60 | type t [@@deriving sexp_of] 61 | 62 | (** Synthesize a [Verilog_design] into a netlist. *) 63 | val create : ?verbose:bool -> ?passes:Pass.t list -> Verilog_design.t -> t Or_error.t 64 | 65 | (** Get a module from the netlist by module name. Note that conversion actally happens on 66 | lookup, hence the error return (this allows us to selectively convert modules from a 67 | netlist, without needing all of them to be correct). *) 68 | val find_module_by_name : t -> string -> Module.t Or_error.t 69 | 70 | (** Return all modules in the netlist *) 71 | val get_all_modules : t -> Module.t list Or_error.t 72 | 73 | (** Convert a raw yosys netlist. *) 74 | val of_yosys_netlist : Yosys_netlist.t -> t Or_error.t 75 | -------------------------------------------------------------------------------- /src/ocaml_module.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open Stdio 3 | open Printf 4 | 5 | module Rebuild_interfaces 6 | (I : Hardcaml.Interface.S) 7 | (O : Hardcaml.Interface.S) 8 | (X : sig 9 | val verilog_design : Verilog_design.t 10 | val loaded_design : Verilog_circuit.t 11 | end) = 12 | struct 13 | let verilog_design = X.verilog_design 14 | 15 | let t_i, t_o, fn = 16 | ( Verilog_circuit.inputs X.loaded_design 17 | , Verilog_circuit.outputs X.loaded_design 18 | , Verilog_circuit.create_fn X.loaded_design ) 19 | ;; 20 | 21 | module I = struct 22 | module T = struct 23 | include I 24 | 25 | let port_names_and_widths = 26 | map port_names ~f:(fun n -> n, (Verilog_circuit.Port.find_exn t_i n).value) 27 | ;; 28 | end 29 | 30 | include T 31 | include Hardcaml.Interface.Make (T) 32 | end 33 | 34 | module O = struct 35 | module T = struct 36 | include O 37 | 38 | let port_names_and_widths = 39 | map port_names ~f:(fun n -> n, (Verilog_circuit.Port.find_exn t_o n).value) 40 | ;; 41 | end 42 | 43 | include O 44 | include Hardcaml.Interface.Make (T) 45 | end 46 | 47 | let create i = 48 | let i = 49 | I.( 50 | to_list 51 | @@ map2 port_names i ~f:(fun n i -> Verilog_circuit.Port.{ name = n; value = i })) 52 | in 53 | let o = fn i |> Or_error.ok_exn in 54 | O.(map port_names ~f:(fun n -> (Verilog_circuit.Port.find_exn o n).value)) 55 | ;; 56 | 57 | let inst ?(name = Verilog_design.top_name verilog_design) ?instance i = 58 | let module Inst = Hardcaml.Instantiation.With_interface (I) (O) in 59 | Inst.create ?instance ~name i 60 | ;; 61 | 62 | let hierarchical ?(name = Verilog_design.top_name verilog_design) ?instance scope = 63 | let module Hier = Hardcaml.Hierarchy.In_scope (I) (O) in 64 | Hier.hierarchical ~scope ?instance ~name (fun _scope -> create) 65 | ;; 66 | end 67 | 68 | let template 69 | ~verilog_design 70 | ~module_type_params 71 | ~module_params 72 | ~input_fields 73 | ~output_fields 74 | ~instantiated_params 75 | = 76 | [%string 77 | {ocaml_module|open Base 78 | 79 | let verilog_design = 80 | Hardcaml_of_verilog.Verilog_design.t_of_sexp 81 | (Parsexp.Single.parse_string_exn {| 82 | %{verilog_design} 83 | |}) 84 | 85 | let name = 86 | Hardcaml_of_verilog.Verilog_design.Module.module_name 87 | (Hardcaml_of_verilog.Verilog_design.top verilog_design) 88 | 89 | module type P = sig 90 | %{module_type_params} 91 | end 92 | 93 | module P = struct 94 | %{module_params} 95 | end 96 | 97 | module I = struct 98 | type 'a t = { 99 | %{input_fields} 100 | }[@@deriving hardcaml] 101 | end 102 | 103 | module O = struct 104 | type 'a t = { 105 | %{output_fields} 106 | }[@@deriving hardcaml] 107 | end 108 | 109 | module From_verilog(P : P)(X : sig 110 | val verbose : bool 111 | val map_verilog_design 112 | : Hardcaml_of_verilog.Verilog_design.t 113 | -> Hardcaml_of_verilog.Verilog_design.t 114 | end) = struct 115 | let params = [ 116 | %{instantiated_params} 117 | ] 118 | 119 | include Hardcaml_of_verilog.Ocaml_module.Rebuild_interfaces(I)(O)(struct 120 | let verilog_design = 121 | Hardcaml_of_verilog.Verilog_design.override_parameters 122 | (X.map_verilog_design verilog_design) params 123 | 124 | let loaded_design = 125 | let create () = 126 | let%bind.Or_error netlist = 127 | Hardcaml_of_verilog.Netlist.create ~verbose:X.verbose verilog_design 128 | in 129 | Hardcaml_of_verilog.Verilog_circuit.create 130 | netlist 131 | ~top_name: 132 | (Hardcaml_of_verilog.Verilog_design.Module.module_name 133 | (Hardcaml_of_verilog.Verilog_design.top verilog_design)) 134 | in 135 | create () |> Or_error.ok_exn 136 | end) 137 | end 138 | 139 | module From_json(X : sig val json : string end) = struct 140 | include Hardcaml_of_verilog.Ocaml_module.Rebuild_interfaces(I)(O)(struct 141 | let verilog_design = verilog_design 142 | 143 | let loaded_design = 144 | let create () = 145 | let%bind.Or_error yosys_netlist = Hardcaml_of_verilog.Expert.Yosys_netlist.of_string X.json in 146 | let%bind.Or_error netlist = Hardcaml_of_verilog.Netlist.of_yosys_netlist yosys_netlist in 147 | Hardcaml_of_verilog.Verilog_circuit.create 148 | netlist 149 | ~top_name: 150 | (Hardcaml_of_verilog.Verilog_design.Module.module_name 151 | (Hardcaml_of_verilog.Verilog_design.top verilog_design)) 152 | in 153 | create () |> Or_error.ok_exn 154 | end) 155 | end 156 | |ocaml_module}] 157 | ;; 158 | 159 | let to_ocaml verilog_design loaded_design = 160 | let open Verilog_design in 161 | let mapping = [ "match", "match_"; "type", "type_" ] in 162 | let oname n = 163 | let n = String.lowercase n in 164 | match List.Assoc.find ~equal:String.equal mapping n with 165 | | Some n -> n 166 | | None -> n 167 | in 168 | let field (p : _ Verilog_circuit.Port.t) = 169 | sprintf " %s : 'a [@rtlname \"%s\"];" (oname p.name) p.name 170 | in 171 | let param_type p = 172 | let name = Parameter.name p in 173 | match Parameter.value p with 174 | | Int _ -> sprintf " val %s : int" (oname name) 175 | | String _ -> sprintf " val %s : string" (oname name) 176 | | v -> 177 | raise_s [%message "Unsupported parameter type" (v : Hardcaml.Parameter.Value.t)] 178 | in 179 | let param_value p = 180 | let name = Parameter.name p in 181 | match Parameter.value p with 182 | | Int x -> sprintf " let %s = %i" (oname name) x 183 | | String x -> sprintf " let %s = \"%s\"" (oname name) x 184 | | v -> 185 | raise_s [%message "Unsupported parameter type" (v : Hardcaml.Parameter.Value.t)] 186 | in 187 | let param_spec p = 188 | let name = Parameter.name p in 189 | let value = Parameter.value p in 190 | let value = 191 | match value with 192 | | Int _ -> "Int" 193 | | String _ -> "String" 194 | | v -> 195 | raise_s [%message "Unsupported parameter type" (v : Hardcaml.Parameter.Value.t)] 196 | in 197 | String.concat 198 | [ " Hardcaml.Parameter.create" 199 | ; " ~name:\"" 200 | ; name 201 | ; "\"" 202 | ; " ~value:(" 203 | ; value 204 | ; " P." 205 | ; oname name 206 | ; ");" 207 | ] 208 | in 209 | let lines l f = String.concat ~sep:"\n" (List.map ~f l) in 210 | let inputs = Verilog_circuit.inputs loaded_design in 211 | let outputs = Verilog_circuit.outputs loaded_design in 212 | let parameters = Verilog_design.(top verilog_design |> Module.parameters) in 213 | template 214 | ~verilog_design:(Sexp.to_string_hum (Verilog_design.sexp_of_t verilog_design)) 215 | ~module_type_params:(lines parameters param_type) 216 | ~module_params:(lines parameters param_value) 217 | ~input_fields:(lines inputs field) 218 | ~output_fields:(lines outputs field) 219 | ~instantiated_params:(lines parameters param_spec) 220 | ;; 221 | 222 | let save_ocaml verilog_design loaded_design ~file = 223 | Out_channel.write_all file ~data:(to_ocaml verilog_design loaded_design) 224 | ;; 225 | -------------------------------------------------------------------------------- /src/ocaml_module.mli: -------------------------------------------------------------------------------- 1 | (** Static construction of an ocaml module with hardcaml interfaces that dynamically loads 2 | the implementation at runtime. Interface widths are adjusted based on instantiation 3 | parameters. *) 4 | 5 | open Base 6 | 7 | module Rebuild_interfaces 8 | (I : Hardcaml.Interface.S) 9 | (O : Hardcaml.Interface.S) 10 | (X : sig 11 | val verilog_design : Verilog_design.t 12 | val loaded_design : Verilog_circuit.t 13 | end) : sig 14 | val verilog_design : Verilog_design.t 15 | 16 | module I : Hardcaml.Interface.S with type 'a t = 'a I.t 17 | module O : Hardcaml.Interface.S with type 'a t = 'a O.t 18 | 19 | val create : Hardcaml.Interface.Create_fn(I)(O).t 20 | val inst : ?name:string -> ?instance:string -> Hardcaml.Interface.Create_fn(I)(O).t 21 | 22 | val hierarchical 23 | : ?name:string 24 | -> ?instance:string 25 | -> Hardcaml.Scope.t 26 | -> Hardcaml.Interface.Create_fn(I)(O).t 27 | end 28 | 29 | val to_ocaml : Verilog_design.t -> Verilog_circuit.t -> string 30 | val save_ocaml : Verilog_design.t -> Verilog_circuit.t -> file:string -> unit 31 | -------------------------------------------------------------------------------- /src/pass.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | | Proc 5 | | Flatten 6 | | Memory of { nomap : bool } 7 | | Opt of { mux_undef : bool } 8 | | Clean 9 | [@@deriving sexp_of, equal] 10 | 11 | let to_string = function 12 | | Proc -> "proc" 13 | | Flatten -> "flatten" 14 | | Memory { nomap } -> 15 | let nomap = if nomap then " -nomap" else "" in 16 | "memory" ^ nomap 17 | | Opt { mux_undef } -> 18 | let mux_undef = if mux_undef then " -mux_undef" else "" in 19 | "opt" ^ mux_undef 20 | | Clean -> "clean" 21 | ;; 22 | -------------------------------------------------------------------------------- /src/pass.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | | Proc 5 | | Flatten 6 | | Memory of { nomap : bool } 7 | | Opt of { mux_undef : bool } 8 | | Clean 9 | [@@deriving sexp_of, equal] 10 | 11 | val to_string : t -> string 12 | -------------------------------------------------------------------------------- /src/synthesize.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Stdio 3 | module V = Verilog_design 4 | module M = V.Module 5 | 6 | let default_passes = 7 | Pass. 8 | [ Proc 9 | ; Flatten 10 | ; Memory { nomap = true } 11 | ; Opt { mux_undef = false } 12 | ; Clean 13 | ; Opt { mux_undef = true } 14 | ; Clean 15 | ] 16 | ;; 17 | 18 | let get_parameters top = 19 | match M.parameters top with 20 | | [] -> None 21 | | params -> 22 | List.map params ~f:(fun p -> 23 | let name = Verilog_design.Parameter.name p in 24 | let value = Verilog_design.Parameter.string_of_value p in 25 | [%string {|-set %{name} %{value}|}]) 26 | |> String.concat ~sep:" " 27 | |> Option.some 28 | ;; 29 | 30 | let get_defines top = 31 | V.defines top 32 | |> List.map ~f:(fun d -> 33 | let value = V.Define.value d in 34 | if V.Define_value.equal No_arg value 35 | then [%string {|-D%{V.Define.name d}|}] 36 | else [%string {|-D%{V.Define.name d}=%{V.Define_value.to_string value}|}]) 37 | |> String.concat ~sep:" " 38 | ;; 39 | 40 | let get_unique_files top predicate = 41 | let rec unique seen modules = 42 | match modules with 43 | | [] -> [] 44 | | hd :: tl -> 45 | if Set.mem seen (M.path hd) 46 | then unique seen tl 47 | else hd :: unique (Set.add seen (M.path hd)) tl 48 | in 49 | M.flat_map top ~f:(fun m -> if predicate m then Some m else None) 50 | |> List.filter_opt 51 | |> unique (Set.empty (module String)) 52 | |> List.rev 53 | ;; 54 | 55 | let yosys_script ?(passes = default_passes) verilog_design ~json_file = 56 | let buffer = Buffer.create 1024 in 57 | let add line = Buffer.add_string buffer (line ^ "\n") in 58 | let top = V.top verilog_design in 59 | let params = get_parameters top in 60 | let defines = get_defines verilog_design in 61 | List.iter (get_unique_files top M.blackbox) ~f:(fun m -> 62 | add [%string {|read_verilog %{defines} -defer -lib %{M.path m}|}]); 63 | List.iter 64 | (get_unique_files top (Fn.non M.blackbox)) 65 | ~f:(fun m -> add [%string {|read_verilog %{defines} -defer %{M.path m}|}]); 66 | (* It seems you must set all parameters at once, or otherwise it sets some, but not 67 | others, in non-untuitive ways. *) 68 | Option.iter params ~f:(fun params -> 69 | add [%string "chparam %{params} %{M.module_name top}"]); 70 | add [%string {|hierarchy -top %{M.module_name top}|}]; 71 | List.iter passes ~f:(fun pass -> add (Pass.to_string pass)); 72 | add [%string {|write_json %{json_file}|}]; 73 | Buffer.contents buffer 74 | ;; 75 | 76 | let tmp_file ~unlink ext = 77 | let name = Filename_unix.temp_file "hardcaml_of_verilog_synthesize_" ext in 78 | if unlink then Stdlib.at_exit (fun () -> Unix.unlink name); 79 | name 80 | ;; 81 | 82 | let tmp_out_channel ~unlink ext = 83 | let name = tmp_file ~unlink ext in 84 | name, Out_channel.create name 85 | ;; 86 | 87 | let write_tmp_yosys_script ?passes verilog_design ~json_file = 88 | let script_name, script = tmp_out_channel ~unlink:true ".yosys" in 89 | Out_channel.output_string script (yosys_script ?passes verilog_design ~json_file); 90 | Out_channel.close script; 91 | script_name 92 | ;; 93 | 94 | let run_yosys ?(verbose = false) args = 95 | let verbose = if verbose then [] else [ "2>/dev/null"; ">/dev/null" ] in 96 | let command = 97 | String.concat 98 | ~sep:" " 99 | (List.concat [ [ Hardcaml.Tools_config.yosys ]; args; verbose ]) 100 | in 101 | match Unix.system command with 102 | | WEXITED 0 -> Ok () 103 | | _ -> Or_error.error_s [%message "YOSYS failed."] 104 | ;; 105 | 106 | let to_json_file ?verbose ?passes verilog_design ~json_file = 107 | let script_name = write_tmp_yosys_script ?passes verilog_design ~json_file in 108 | run_yosys ?verbose [ "-s"; script_name ] 109 | ;; 110 | 111 | let to_yosys_netlist ?verbose ?passes verilog_design = 112 | let json_file = tmp_file ~unlink:true ".json" in 113 | let%bind.Or_error () = to_json_file ?verbose ?passes verilog_design ~json_file in 114 | let%bind.Or_error json = Or_error.try_with (fun () -> In_channel.read_all json_file) in 115 | Yosys_netlist.of_string json 116 | ;; 117 | -------------------------------------------------------------------------------- /src/synthesize.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | val yosys_script : ?passes:Pass.t list -> Verilog_design.t -> json_file:string -> string 4 | 5 | val to_json_file 6 | : ?verbose:bool 7 | -> ?passes:Pass.t list 8 | -> Verilog_design.t 9 | -> json_file:string 10 | -> unit Or_error.t 11 | 12 | val to_yosys_netlist 13 | : ?verbose:bool 14 | -> ?passes:Pass.t list 15 | -> Verilog_design.t 16 | -> Yosys_netlist.t Or_error.t 17 | -------------------------------------------------------------------------------- /src/techlib.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hardcaml 3 | open Signal 4 | module Cell = Netlist.Cell 5 | module Port = Netlist.Port 6 | 7 | module Cell_implementation = struct 8 | type create_fn = 9 | Cell.t -> Parameter.t list -> Signal.t Port.t list -> Signal.t Port.t list Or_error.t 10 | 11 | type t = 12 | { name : string 13 | ; create_fn : create_fn 14 | } 15 | end 16 | 17 | let pint = function 18 | | { Parameter.name = _; value = Int i } -> i 19 | | parameter -> raise_s [%message "expecting int parameter" (parameter : Parameter.t)] 20 | ;; 21 | 22 | let pstr = function 23 | | { Parameter.name = _; value = String s } -> s 24 | | parameter -> raise_s [%message "expecting string parameter" (parameter : Parameter.t)] 25 | ;; 26 | 27 | let pconst w = function 28 | | { Parameter.name = _; value = Int i } -> Signal.of_int_trunc ~width:w i 29 | | { Parameter.name = _; value = String s } -> 30 | Signal.of_string (Int.to_string w ^ "'b" ^ s) 31 | | parameter -> raise_s [%message "bad const value" (parameter : Parameter.t)] 32 | ;; 33 | 34 | let find_exn (ports : _ Port.t list) name = 35 | List.find ~f:(fun p -> String.equal p.name name) ports 36 | |> Option.value_exn 37 | ~error: 38 | (Error.create_s 39 | [%message "Cannot find port" (name : string) (ports : _ Port.t list)]) 40 | |> Port.value 41 | ;; 42 | 43 | let ( ^~: ) a b = ~:(a ^: b) 44 | 45 | (* Convert cells written in terms of hardcaml interfaces into [Cell_implementaion.t]s *) 46 | module Implement_cell 47 | (P : Hardcaml.Interface.S) 48 | (I : Hardcaml.Interface.S) 49 | (O : Hardcaml.Interface.S) : sig 50 | type t = string * (Cell.t -> Parameter.t P.t -> Signal.t I.t -> Signal.t O.t) 51 | 52 | val cell_implementation : t -> Cell_implementation.t 53 | end = struct 54 | type t = string * (Cell.t -> Parameter.t P.t -> Signal.t I.t -> Signal.t O.t) 55 | 56 | let of_list_p l = 57 | P.map 58 | ~f:(fun n -> 59 | let name = Parameter_name.of_string n in 60 | { Parameter.name; value = Parameter.find_name_exn l name }) 61 | P.port_names 62 | ;; 63 | 64 | let of_list_i l = I.map I.port_names ~f:(fun n -> find_exn l n) 65 | 66 | let to_list_o o = 67 | O.to_list @@ O.map2 O.port_names o ~f:(fun name value -> { Port.name; value }) 68 | ;; 69 | 70 | let cell_implementation (name, f) = 71 | { Cell_implementation.name 72 | ; create_fn = 73 | (fun c p i -> 74 | try Ok (to_list_o @@ f c (of_list_p p) (of_list_i i)) with 75 | | e -> 76 | Or_error.error_s 77 | [%message 78 | "Failed to instantiation cell implementation" 79 | (name : string) 80 | (e : exn) 81 | (p : Parameter.t list)]) 82 | } 83 | ;; 84 | end 85 | 86 | module Op1 = struct 87 | module P = struct 88 | type 'a t = 89 | { a_signed : 'a [@rtlname "A_SIGNED"] 90 | ; a_width : 'a [@rtlname "A_WIDTH"] 91 | ; y_width : 'a [@rtlname "Y_WIDTH"] 92 | } 93 | [@@deriving hardcaml] 94 | end 95 | 96 | module I = struct 97 | type 'a t = { a : 'a [@rtlname "A"] } [@@deriving hardcaml] 98 | end 99 | 100 | module O = struct 101 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 102 | end 103 | 104 | module W = Implement_cell (P) (I) (O) 105 | 106 | let res p = if p.P.a_signed = 1 then sresize else uresize 107 | 108 | let f1 f _ p i = 109 | let p = P.map ~f:pint p in 110 | assert (width i.I.a = p.P.a_width); 111 | let a = (res p) i.I.a ~width:p.P.y_width in 112 | O.{ y = f a } 113 | ;; 114 | 115 | let not_ = "$not", f1 ( ~: ) 116 | let pos = "$pos", f1 (fun x -> x) 117 | let neg = "$neg", f1 negate 118 | 119 | let fr f _ p i = 120 | let p = P.map ~f:pint p in 121 | assert (width i.I.a = p.P.a_width); 122 | O.{ y = uresize (reduce ~f (bits_msb i.I.a)) ~width:p.P.y_width } 123 | ;; 124 | 125 | let reduce_or = "$reduce_or", fr ( |: ) 126 | let reduce_and = "$reduce_and", fr ( &: ) 127 | let reduce_xor = "$reduce_xor", fr ( ^: ) 128 | 129 | let reduce_xnor = 130 | ( "$reduce_xnor" 131 | , fun _ p i -> 132 | let p = P.map ~f:pint p in 133 | assert (width i.I.a = p.P.a_width); 134 | let y = reduce ~f:( ^: ) (bits_msb i.I.a) in 135 | O.{ y = uresize ~:y ~width:p.P.y_width } ) 136 | ;; 137 | 138 | let reduce_bool = "$reduce_bool", fr ( |: ) 139 | 140 | let logic_not = 141 | ( "$logic_not" 142 | , fun _ p i -> 143 | let p = P.map ~f:pint p in 144 | assert (width i.I.a = p.P.a_width); 145 | let y = i.I.a ==:. 0 in 146 | O.{ y = uresize y ~width:p.P.y_width } ) 147 | ;; 148 | 149 | let cells = 150 | [ not_ 151 | ; pos 152 | ; neg 153 | ; reduce_or 154 | ; reduce_and 155 | ; reduce_xor 156 | ; reduce_xnor 157 | ; reduce_bool 158 | ; logic_not 159 | ] 160 | |> List.map ~f:W.cell_implementation 161 | ;; 162 | 163 | let _get_input_width p = I.{ a = p.P.a_width } 164 | let _get_output_width p = O.{ y = p.P.y_width } 165 | end 166 | 167 | module Op2 = struct 168 | module P = struct 169 | type 'a t = 170 | { a_signed : 'a [@rtlname "A_SIGNED"] 171 | ; b_signed : 'a [@rtlname "B_SIGNED"] 172 | ; a_width : 'a [@rtlname "A_WIDTH"] 173 | ; b_width : 'a [@rtlname "B_WIDTH"] 174 | ; y_width : 'a [@rtlname "Y_WIDTH"] 175 | } 176 | [@@deriving hardcaml] 177 | end 178 | 179 | module I = struct 180 | type 'a t = 181 | { a : 'a [@rtlname "A"] 182 | ; b : 'a [@rtlname "B"] 183 | } 184 | [@@deriving hardcaml] 185 | end 186 | 187 | module O = struct 188 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 189 | end 190 | 191 | module W = Implement_cell (P) (I) (O) 192 | 193 | let res p = if p.P.a_signed = 1 && p.P.b_signed = 1 then sresize else uresize 194 | 195 | let f2 f _ p i = 196 | let p = P.map ~f:pint p in 197 | assert (width i.I.a = p.P.a_width); 198 | assert (width i.I.b = p.P.b_width); 199 | let a = (res p) i.I.a ~width:p.P.y_width in 200 | let b = (res p) i.I.b ~width:p.P.y_width in 201 | O.{ y = uresize (f a b) ~width:p.P.y_width } 202 | ;; 203 | 204 | let and_ = "$and", f2 ( &: ) 205 | let or_ = "$or", f2 ( |: ) 206 | let xor_ = "$xor", f2 ( ^: ) 207 | let xnor_ = "$xnor", f2 ( ^~: ) 208 | let add = "$add", f2 ( +: ) 209 | let sub = "$sub", f2 ( -: ) 210 | 211 | let mul = 212 | ( "$mul" 213 | , fun _ p i -> 214 | let p = P.map ~f:pint p in 215 | assert (width i.I.a = p.P.a_width); 216 | assert (width i.I.b = p.P.b_width); 217 | let is_signed = p.P.a_signed = 1 && p.P.b_signed = 1 in 218 | let a = (res p) i.I.a ~width:p.P.y_width in 219 | let b = (res p) i.I.b ~width:p.P.y_width in 220 | let ( *: ) a b = 221 | if is_signed 222 | then sresize (a *+ b) ~width:p.P.y_width 223 | else uresize (a *: b) ~width:p.P.y_width 224 | in 225 | O.{ y = a *: b } ) 226 | ;; 227 | 228 | let fs f _ p i = 229 | let p = P.map ~f:pint p in 230 | assert (width i.I.a = p.P.a_width); 231 | assert (width i.I.b = p.P.b_width); 232 | let a = 233 | (if p.P.a_signed = 1 then sresize else uresize) 234 | i.I.a 235 | ~width:(max p.P.y_width p.P.a_width) 236 | in 237 | O.{ y = uresize (f p.P.a_signed a i.I.b) ~width:p.P.y_width } 238 | ;; 239 | 240 | let shl = "$shl", fs (fun _ a b -> log_shift ~f:sll a ~by:b) 241 | let shr = "$shr", fs (fun _ a b -> log_shift ~f:srl a ~by:b) 242 | 243 | let fss f _ p i = 244 | let p = P.map ~f:pint p in 245 | assert (width i.I.a = p.P.a_width); 246 | assert (width i.I.b = p.P.b_width); 247 | let a = 248 | (if p.P.a_signed = 1 then sresize else uresize) 249 | i.I.a 250 | ~width:(max p.P.a_width p.P.y_width) 251 | in 252 | O.{ y = uresize (f p.P.a_signed a i.I.b) ~width:p.P.y_width } 253 | ;; 254 | 255 | let sshl = "$sshl", fss (fun _ a b -> log_shift ~f:sll a ~by:b) 256 | let sshr = "$sshr", fss (fun s a b -> log_shift ~f:(if s = 1 then sra else srl) a ~by:b) 257 | 258 | let shift = 259 | ( "$shift" 260 | , fun _ p i -> 261 | let p = P.map ~f:pint p in 262 | assert (width i.I.a = p.P.a_width); 263 | assert (width i.I.b = p.P.b_width); 264 | let a = uresize i.I.a ~width:(max p.P.a_width p.P.y_width) in 265 | let y = 266 | if p.P.b_signed = 1 267 | then 268 | mux2 269 | (msb i.I.b) 270 | (log_shift ~f:sll a ~by:(negate i.I.b)) 271 | (log_shift ~f:srl a ~by:i.I.b) 272 | else log_shift ~f:srl a ~by:i.I.b 273 | in 274 | O.{ y = uresize y ~width:p.P.y_width } ) 275 | ;; 276 | 277 | let shiftx = 278 | ( "$shiftx" 279 | , fun _ p i -> 280 | let p = P.map ~f:pint p in 281 | assert (width i.I.a = p.P.a_width); 282 | assert (width i.I.b = p.P.b_width); 283 | let a = uresize i.I.a ~width:(max p.P.a_width p.P.y_width) in 284 | let y = 285 | if p.P.b_signed = 1 286 | then 287 | mux2 288 | (msb i.I.b) 289 | (log_shift ~f:sll a ~by:(negate i.I.b)) 290 | (log_shift ~f:srl a ~by:i.I.b) 291 | else log_shift ~f:srl a ~by:i.I.b 292 | in 293 | O.{ y = uresize y ~width:p.P.y_width } ) 294 | ;; 295 | 296 | (* let macc = ... *) 297 | (* let div = ... *) 298 | (* let mod = ... *) 299 | (* let pow = ... *) 300 | 301 | let fl f _ p i = 302 | let p = P.map ~f:pint p in 303 | assert (width i.I.a = p.P.a_width); 304 | assert (width i.I.b = p.P.b_width); 305 | O.{ y = uresize (f i.I.a i.I.b) ~width:p.P.y_width } 306 | ;; 307 | 308 | let logic_and = "$logic_and", fl (fun a b -> a <>:. 0 &: (b <>:. 0)) 309 | let logic_or = "$logic_or", fl (fun a b -> a <>:. 0 |: (b <>:. 0)) 310 | 311 | let fc fs fu _ p i = 312 | let p = P.map ~f:pint p in 313 | assert (width i.I.a = p.P.a_width); 314 | assert (width i.I.b = p.P.b_width); 315 | let w = max p.P.a_width p.P.b_width in 316 | let a = (res p) i.I.a ~width:w in 317 | let b = (res p) i.I.b ~width:w in 318 | O. 319 | { y = 320 | uresize 321 | ((if p.P.a_signed = 1 && p.P.b_signed = 1 then fs else fu) a b) 322 | ~width:p.P.y_width 323 | } 324 | ;; 325 | 326 | let lt = "$lt", fc ( <+ ) ( <: ) 327 | let le = "$le", fc ( <=+ ) ( <=: ) 328 | let gt = "$gt", fc ( >+ ) ( >: ) 329 | let ge = "$ge", fc ( >=+ ) ( >=: ) 330 | let eq = "$eq", fc ( ==: ) ( ==: ) 331 | let ne = "$ne", fc ( <>: ) ( <>: ) 332 | let eqx = "$eqx", fc ( ==: ) ( ==: ) 333 | let nex = "$nex", fc ( <>: ) ( <>: ) 334 | 335 | let cells = 336 | [ and_ 337 | ; or_ 338 | ; xor_ 339 | ; xnor_ 340 | ; add 341 | ; sub 342 | ; mul 343 | ; shl 344 | ; shr 345 | ; sshl 346 | ; sshr 347 | ; shift 348 | ; shiftx 349 | ; logic_and 350 | ; logic_or 351 | ; lt 352 | ; le 353 | ; gt 354 | ; ge 355 | ; eq 356 | ; ne 357 | ; eqx 358 | ; nex 359 | ] 360 | |> List.map ~f:W.cell_implementation 361 | ;; 362 | 363 | let _get_input_width p = I.{ a = p.P.a_width; b = p.P.b_width } 364 | let _get_output_width p = O.{ y = p.P.y_width } 365 | end 366 | 367 | module Fa = struct 368 | module P = struct 369 | type 'a t = { width : 'a [@rtlname "WIDTH"] } [@@deriving hardcaml] 370 | end 371 | 372 | module I = struct 373 | type 'a t = 374 | { a : 'a [@rtlname "A"] 375 | ; b : 'a [@rtlname "B"] 376 | ; c : 'a [@rtlname "C"] 377 | } 378 | [@@deriving hardcaml] 379 | end 380 | 381 | module O = struct 382 | type 'a t = 383 | { x : 'a [@rtlname "X"] 384 | ; y : 'a [@rtlname "Y"] 385 | } 386 | [@@deriving hardcaml] 387 | end 388 | 389 | module W = Implement_cell (P) (I) (O) 390 | 391 | let fa _ p i = 392 | let wid = pint p.P.width in 393 | assert (width i.I.a = wid); 394 | assert (width i.I.b = wid); 395 | assert (width i.I.c = wid); 396 | let t1 = i.I.a ^: i.I.b in 397 | let t2 = i.I.a &: i.I.b in 398 | let t3 = i.I.c &: t1 in 399 | O.{ x = t2 |: t3; y = t1 ^: i.I.c } 400 | ;; 401 | 402 | let fa = "$fa", fa 403 | let cells = [ fa ] |> List.map ~f:W.cell_implementation 404 | let _get_input_width p = I.{ a = p.P.width; b = p.P.width; c = p.P.width } 405 | let _get_output_width p = O.{ x = p.P.width; y = p.P.width } 406 | end 407 | 408 | module Lcu = struct 409 | module P = struct 410 | type 'a t = { width : 'a [@rtlname "WIDTH"] } [@@deriving hardcaml] 411 | end 412 | 413 | module I = struct 414 | type 'a t = 415 | { p : 'a [@rtlname "P"] 416 | ; g : 'a [@rtlname "G"] 417 | ; ci : 'a [@rtlname "CI"] 418 | } 419 | [@@deriving hardcaml] 420 | end 421 | 422 | module O = struct 423 | type 'a t = { co : 'a [@rtlname "CO"] } [@@deriving hardcaml] 424 | end 425 | 426 | module W = Implement_cell (P) (I) (O) 427 | 428 | let lcu _ p i = 429 | let wid = pint p.P.width in 430 | assert (width i.I.p = wid); 431 | assert (width i.I.g = wid); 432 | assert (width i.I.ci = 1); 433 | let p = bits_lsb i.I.p in 434 | let g = bits_lsb i.I.g in 435 | let rec f p g ci = 436 | match p, g with 437 | | [], [] -> [] 438 | | p :: p', g :: g' -> 439 | let co = g |: (p &: ci) in 440 | co :: f p' g' co 441 | | _ -> failwith "'p' and 'g' list lengths in lcu are not the same" 442 | in 443 | let co = concat_lsb (f p g i.I.ci) in 444 | O.{ co } 445 | ;; 446 | 447 | let lcu = "$lcu", lcu 448 | let cells = [ lcu ] |> List.map ~f:W.cell_implementation 449 | let _get_input_width p = I.{ p = p.P.width; g = p.P.width; ci = 1 } 450 | let _get_output_width p = O.{ co = p.P.width } 451 | end 452 | 453 | module Slice = struct 454 | module P = struct 455 | type 'a t = 456 | { offset : 'a [@rtlname "OFFSET"] 457 | ; a_width : 'a [@rtlname "A_WIDTH"] 458 | ; y_width : 'a [@rtlname "Y_WIDTH"] 459 | } 460 | [@@deriving hardcaml] 461 | end 462 | 463 | module I = struct 464 | type 'a t = { a : 'a [@rtlname "A"] } [@@deriving hardcaml] 465 | end 466 | 467 | module O = struct 468 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 469 | end 470 | 471 | module W = Implement_cell (P) (I) (O) 472 | 473 | let slice _ p i = 474 | let p = P.map ~f:pint p in 475 | assert (width i.I.a = p.P.a_width); 476 | O.{ y = uresize (srl i.I.a ~by:p.P.offset) ~width:p.P.y_width } 477 | ;; 478 | 479 | let slice = "$slice", slice 480 | let cells = [ slice ] |> List.map ~f:W.cell_implementation 481 | let _get_input_width p = I.{ a = p.P.a_width } 482 | let _get_output_width p = O.{ y = p.P.y_width } 483 | end 484 | 485 | module Concat = struct 486 | module P = struct 487 | type 'a t = 488 | { a_width : 'a [@rtlname "A_WIDTH"] 489 | ; b_width : 'a [@rtlname "B_WIDTH"] 490 | } 491 | [@@deriving hardcaml] 492 | end 493 | 494 | module I = struct 495 | type 'a t = 496 | { a : 'a [@rtlname "A"] 497 | ; b : 'a [@rtlname "B"] 498 | } 499 | [@@deriving hardcaml] 500 | end 501 | 502 | module O = struct 503 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 504 | end 505 | 506 | module W = Implement_cell (P) (I) (O) 507 | 508 | let concat _ p i = 509 | let p = P.map ~f:pint p in 510 | assert (width i.I.a = p.P.a_width); 511 | assert (width i.I.b = p.P.b_width); 512 | O.{ y = i.I.b @: i.I.a } 513 | ;; 514 | 515 | let concat = "$concat", concat 516 | let cells = [ concat ] |> List.map ~f:W.cell_implementation 517 | let _get_input_width p = I.{ a = p.P.a_width; b = p.P.b_width } 518 | let _get_output_width p = O.{ y = p.P.a_width + p.P.b_width } 519 | end 520 | 521 | module Mux = struct 522 | module P = struct 523 | type 'a t = { width : 'a [@rtlname "WIDTH"] } [@@deriving hardcaml] 524 | end 525 | 526 | module I = struct 527 | type 'a t = 528 | { a : 'a [@rtlname "A"] 529 | ; b : 'a [@rtlname "B"] 530 | ; s : 'a [@rtlname "S"] 531 | } 532 | [@@deriving hardcaml] 533 | end 534 | 535 | module O = struct 536 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 537 | end 538 | 539 | module W = Implement_cell (P) (I) (O) 540 | 541 | let mux _ p i = 542 | let p = P.map ~f:pint p in 543 | assert (width i.I.a = p.P.width); 544 | assert (width i.I.b = p.P.width); 545 | assert (width i.I.s = 1); 546 | O.{ y = mux2 i.I.s i.I.b i.I.a } 547 | ;; 548 | 549 | let mux = "$mux", mux 550 | let cells = [ mux ] |> List.map ~f:W.cell_implementation 551 | let _get_input_width p = I.{ a = p.P.width; b = p.P.width; s = 1 } 552 | let _get_output_width p = O.{ y = p.P.width } 553 | end 554 | 555 | module Pmux = struct 556 | module P = struct 557 | type 'a t = 558 | { width : 'a [@rtlname "WIDTH"] 559 | ; s_width : 'a [@rtlname "S_WIDTH"] 560 | } 561 | [@@deriving hardcaml] 562 | end 563 | 564 | module I = struct 565 | type 'a t = 566 | { a : 'a [@rtlname "A"] 567 | ; b : 'a [@rtlname "B"] 568 | ; s : 'a [@rtlname "S"] 569 | } 570 | [@@deriving hardcaml] 571 | end 572 | 573 | module O = struct 574 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 575 | end 576 | 577 | module W = Implement_cell (P) (I) (O) 578 | 579 | let pmux _ p i = 580 | let p = P.map ~f:pint p in 581 | assert (width i.I.a = p.P.width); 582 | assert (width i.I.b = p.P.width * p.P.s_width); 583 | assert (width i.I.s = p.P.s_width); 584 | let rec pmux s a b i = 585 | match s with 586 | | [] -> a 587 | | s :: t -> 588 | let b' = b.:[((i + 1) * p.P.width) - 1, i * p.P.width] in 589 | mux2 s b' (pmux t a b (i + 1)) 590 | in 591 | O.{ y = pmux (bits_lsb i.I.s) i.I.a i.I.b 0 } 592 | ;; 593 | 594 | let pmux = "$pmux", pmux 595 | let cells = [ pmux ] |> List.map ~f:W.cell_implementation 596 | 597 | let _get_input_width p = 598 | I.{ a = p.P.width; b = p.P.width * p.P.s_width; s = p.P.s_width } 599 | ;; 600 | 601 | let _get_output_width p = O.{ y = p.P.width } 602 | end 603 | 604 | module Lut = struct 605 | module P = struct 606 | type 'a t = 607 | { width : 'a [@rtlname "WIDTH"] 608 | ; lut : 'a [@rtlname "LUT"] 609 | } 610 | [@@deriving hardcaml] 611 | end 612 | 613 | module I = struct 614 | type 'a t = { a : 'a [@rtlname "A"] } [@@deriving hardcaml] 615 | end 616 | 617 | module O = struct 618 | type 'a t = { y : 'a [@rtlname "Y"] } [@@deriving hardcaml] 619 | end 620 | 621 | module W = Implement_cell (P) (I) (O) 622 | 623 | let lut _ p i = 624 | let p = P.map ~f:pint p in 625 | assert (width i.I.a = p.P.width); 626 | let lut = of_int_trunc ~width:(1 lsl p.P.width) p.P.lut in 627 | let y = 628 | mux i.I.a (Array.to_list @@ Array.init (1 lsl p.P.width) ~f:(fun pos -> lut.:(pos))) 629 | in 630 | O.{ y } 631 | ;; 632 | 633 | let lut = "$lut", lut 634 | let cells = [ lut ] |> List.map ~f:W.cell_implementation 635 | let _get_input_width p = I.{ a = p.P.width } 636 | let _get_output_width _ = O.{ y = 1 } 637 | end 638 | 639 | (* module Alu = struct .. end *) 640 | (* module Tribuf = struct .. end *) 641 | (* module Assert = struct .. end *) 642 | (* module Assume = struct .. end *) 643 | (* module Equiv = struct .. end *) 644 | 645 | let reg_spec ?clock_edge ?reset ?reset_edge ~clock () = 646 | Reg_spec.create ~clock ?clock_edge ?reset ?reset_edge () 647 | ;; 648 | 649 | (* module Sr = struct end *) 650 | 651 | module Dff = struct 652 | module P = struct 653 | type 'a t = 654 | { width : 'a [@rtlname "WIDTH"] 655 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 656 | } 657 | [@@deriving hardcaml] 658 | end 659 | 660 | module I = struct 661 | type 'a t = 662 | { clk : 'a [@rtlname "CLK"] 663 | ; d : 'a [@rtlname "D"] 664 | } 665 | [@@deriving hardcaml] 666 | end 667 | 668 | module O = struct 669 | type 'a t = { q : 'a [@rtlname "Q"] } [@@deriving hardcaml] 670 | end 671 | 672 | module W = Implement_cell (P) (I) (O) 673 | 674 | let dff _ p i = 675 | let open I in 676 | let p = P.map ~f:pint p in 677 | assert (width i.d = p.P.width); 678 | let clock_edge : Edge.t = if p.P.clk_polarity = 1 then Rising else Falling in 679 | O.{ q = reg (reg_spec ~clock:i.clk ~clock_edge ()) i.d } 680 | ;; 681 | 682 | let dff = "$dff", dff 683 | let cells = [ dff ] |> List.map ~f:W.cell_implementation 684 | let _get_input_width p = I.{ clk = 1; d = p.P.width } 685 | let _get_output_width p = O.{ q = p.P.width } 686 | end 687 | 688 | module Dffe = struct 689 | module P = struct 690 | type 'a t = 691 | { width : 'a [@rtlname "WIDTH"] 692 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 693 | ; en_polarity : 'a [@rtlname "EN_POLARITY"] 694 | } 695 | [@@deriving hardcaml] 696 | end 697 | 698 | module I = struct 699 | type 'a t = 700 | { clk : 'a [@rtlname "CLK"] 701 | ; en : 'a [@rtlname "EN"] 702 | ; d : 'a [@rtlname "D"] 703 | } 704 | [@@deriving hardcaml] 705 | end 706 | 707 | module O = struct 708 | type 'a t = { q : 'a [@rtlname "Q"] } [@@deriving hardcaml] 709 | end 710 | 711 | module W = Implement_cell (P) (I) (O) 712 | 713 | let dffe _ p i = 714 | let open I in 715 | let p = P.map ~f:pint p in 716 | assert (width i.d = p.P.width); 717 | let clock_edge : Edge.t = if p.P.clk_polarity = 1 then Rising else Falling in 718 | let enable = if p.P.en_polarity = 1 then i.en else ~:(i.en) in 719 | O.{ q = reg (reg_spec ~clock:i.clk ~clock_edge ()) ~enable i.d } 720 | ;; 721 | 722 | let dffe = "$dffe", dffe 723 | let cells = [ dffe ] |> List.map ~f:W.cell_implementation 724 | let _get_input_width p = I.{ clk = 1; en = 1; d = p.P.width } 725 | let _get_output_width p = O.{ q = p.P.width } 726 | end 727 | 728 | module Dffsr = struct 729 | module P = struct 730 | type 'a t = 731 | { width : 'a [@rtlname "WIDTH"] 732 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 733 | ; set_polarity : 'a [@rtlname "SET_POLARITY"] 734 | ; clr_polarity : 'a [@rtlname "CLR_POLARITY"] 735 | } 736 | [@@deriving hardcaml] 737 | end 738 | 739 | module I = struct 740 | type 'a t = 741 | { clk : 'a [@rtlname "CLK"] 742 | ; set : 'a [@rtlname "SET"] 743 | ; clr : 'a [@rtlname "CLR"] 744 | ; d : 'a [@rtlname "D"] 745 | } 746 | [@@deriving hardcaml] 747 | end 748 | 749 | module O = struct 750 | type 'a t = { q : 'a [@rtlname "Q"] } [@@deriving hardcaml] 751 | end 752 | 753 | module W = Implement_cell (P) (I) (O) 754 | 755 | let dffsr _ p i = 756 | let open I in 757 | let p = P.map ~f:pint p in 758 | assert (width i.d = p.P.width); 759 | assert (width i.set = p.P.width); 760 | assert (width i.clr = p.P.width); 761 | let clock_edge : Edge.t = if p.P.clk_polarity = 1 then Rising else Falling in 762 | let dffsr set clr d = 763 | let set = if p.P.set_polarity = 1 then set else ~:set in 764 | let clr = if p.P.clr_polarity = 1 then clr else ~:clr in 765 | reg 766 | (reg_spec ~clock:i.clk ~clock_edge ~reset:(set |: clr) ()) 767 | ~reset_to:(mux2 clr gnd vdd) 768 | d 769 | in 770 | O. 771 | { q = 772 | concat_lsb 773 | @@ Array.to_list 774 | @@ Array.init p.P.width ~f:(fun j -> dffsr i.set.:(j) i.clr.:(j) i.d.:(j)) 775 | } 776 | ;; 777 | 778 | let dffsr = "$dffsr", dffsr 779 | let cells = [ dffsr ] |> List.map ~f:W.cell_implementation 780 | let _get_input_width p = I.{ clk = 1; set = p.P.width; clr = p.P.width; d = p.P.width } 781 | let _get_output_width p = O.{ q = p.P.width } 782 | end 783 | 784 | module Adff = struct 785 | module P = struct 786 | type 'a t = 787 | { width : 'a [@rtlname "WIDTH"] 788 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 789 | ; arst_polarity : 'a [@rtlname "ARST_POLARITY"] 790 | ; arst_value : 'a [@rtlname "ARST_VALUE"] 791 | } 792 | [@@deriving hardcaml] 793 | end 794 | 795 | module I = struct 796 | type 'a t = 797 | { clk : 'a [@rtlname "CLK"] 798 | ; arst : 'a [@rtlname "ARST"] 799 | ; d : 'a [@rtlname "D"] 800 | } 801 | [@@deriving hardcaml] 802 | end 803 | 804 | module O = struct 805 | type 'a t = { q : 'a [@rtlname "Q"] } [@@deriving hardcaml] 806 | end 807 | 808 | module W = Implement_cell (P) (I) (O) 809 | 810 | let adff _ p i = 811 | let open I in 812 | let arst_value = pconst (pint p.P.width) p.P.arst_value in 813 | let p = 814 | P.map 815 | ~f:(fun p -> 816 | try pint p with 817 | | _ -> 0) 818 | p 819 | in 820 | assert (width i.d = p.P.width); 821 | let clock_edge : Edge.t = if p.P.clk_polarity = 1 then Rising else Falling in 822 | let reset_edge : Edge.t = if p.P.arst_polarity = 1 then Rising else Falling in 823 | let rv = arst_value in 824 | O. 825 | { q = 826 | reg 827 | (reg_spec ~clock:i.clk ~clock_edge ~reset:i.arst ~reset_edge ()) 828 | ~reset_to:rv 829 | i.d 830 | } 831 | ;; 832 | 833 | let adff = "$adff", adff 834 | let cells = [ adff ] |> List.map ~f:W.cell_implementation 835 | let _get_input_width p = I.{ clk = 1; arst = 1; d = p.P.width } 836 | let _get_output_width p = O.{ q = p.P.width } 837 | end 838 | 839 | (* module dlatchsr = struct ... end *) 840 | (* module fsm = struct ... end *) 841 | 842 | (* module memrd = struct ... end *) 843 | (* module memwr = struct ... end *) 844 | (* module meminit = struct ... end *) 845 | (* module mem = struct ... end *) 846 | 847 | module (* memwr node (for use with memory -dff) - not currently used *) _ = struct 848 | module P = struct 849 | type 'a t = 850 | { priority : 'a [@rtlname "PRIORITY"] 851 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 852 | ; clk_enable : 'a [@rtlname "CLK_ENABLE"] 853 | ; width : 'a [@rtlname "WIDTH"] 854 | ; abits : 'a [@rtlname "ABITS"] 855 | ; memid : 'a [@rtlname "MEMID"] 856 | } 857 | [@@deriving hardcaml] 858 | end 859 | 860 | module I = struct 861 | type 'a t = 862 | { en : 'a [@rtlname "EN"] 863 | ; clk : 'a [@rtlname "CLK"] 864 | ; data : 'a [@rtlname "DATA"] 865 | ; addr : 'a [@rtlname "ADDR"] 866 | } 867 | [@@deriving hardcaml] 868 | end 869 | 870 | module O = Hardcaml.Interface.Empty 871 | module W = Implement_cell (P) (I) (O) 872 | 873 | let _get_input_width p = 874 | I.{ en = p.P.width; clk = 1; data = p.P.width; addr = p.P.abits } 875 | ;; 876 | 877 | let _get_output_width _ = O.port_widths 878 | 879 | let memwr _ p i = 880 | let open I in 881 | let memid = pstr p.P.memid in 882 | let p = 883 | P.map 884 | ~f:(fun p -> 885 | try pint p with 886 | | _ -> 0) 887 | p 888 | in 889 | assert (width i.en = p.P.width); 890 | assert (width i.clk = 1); 891 | assert (width i.data = p.P.width); 892 | assert (width i.addr = p.P.abits); 893 | let p' = 894 | P.( 895 | to_list 896 | @@ { (map2 ~f:(fun name x -> Parameter.create ~name ~value:(Int x)) port_names p) with 897 | memid = Parameter.create ~name:"MEMID" ~value:(String memid) 898 | }) 899 | in 900 | let inst = 901 | Instantiation.create 902 | () 903 | ~name:"memwr" 904 | ~parameters:p' 905 | ~inputs:I.(to_list @@ zip port_names i) 906 | ~outputs:O.(to_list @@ zip port_names (_get_output_width p)) 907 | in 908 | O.(map ~f:(fun n -> Instantiation.output inst n) port_names) 909 | ;; 910 | 911 | let memwr = "$memwr", memwr 912 | let _cells = [ memwr ] |> List.map ~f:W.cell_implementation 913 | end 914 | 915 | module (* memrd node (for use with memory -dff) - not currently used *) _ = struct 916 | module P = struct 917 | type 'a t = 918 | { transparent : 'a [@rtlname "TRANSPARENT"] 919 | ; clk_polarity : 'a [@rtlname "CLK_POLARITY"] 920 | ; clk_enable : 'a [@rtlname "CLK_ENABLE"] 921 | ; width : 'a [@rtlname "WIDTH"] 922 | ; abits : 'a [@rtlname "ABITS"] 923 | ; memid : 'a [@rtlname "MEMID"] 924 | } 925 | [@@deriving hardcaml] 926 | end 927 | 928 | module I = struct 929 | type 'a t = 930 | { en : 'a [@rtlname "EN"] 931 | ; clk : 'a [@rtlname "CLK"] 932 | ; addr : 'a [@rtlname "ADDR"] 933 | } 934 | [@@deriving hardcaml] 935 | end 936 | 937 | module O = struct 938 | type 'a t = { data : 'a [@rtlname "DATA"] } [@@deriving hardcaml] 939 | end 940 | 941 | module W = Implement_cell (P) (I) (O) 942 | 943 | let _get_input_width p = I.{ en = p.P.width; clk = 1; addr = p.P.abits } 944 | let _get_output_width p = O.{ data = p.P.width } 945 | 946 | let memrd _ p i = 947 | let open I in 948 | let memid = pstr p.P.memid in 949 | let p = 950 | P.map 951 | ~f:(fun p -> 952 | try pint p with 953 | | _ -> 0) 954 | p 955 | in 956 | assert (width i.en = 1); 957 | assert (width i.clk = 1); 958 | assert (width i.addr = p.P.abits); 959 | let p' = 960 | P.( 961 | to_list 962 | @@ { (map2 ~f:(fun name x -> Parameter.create ~name ~value:(Int x)) port_names p) with 963 | memid = Parameter.create ~name:"MEMID" ~value:(String memid) 964 | }) 965 | in 966 | let inst = 967 | Instantiation.create 968 | () 969 | ~name:"memrd" 970 | ~parameters:p' 971 | ~inputs:I.(to_list @@ zip port_names i) 972 | ~outputs:O.(to_list @@ zip port_names (_get_output_width p)) 973 | in 974 | O.(map ~f:(fun n -> Instantiation.output inst n) port_names) 975 | ;; 976 | 977 | let memrd = "$memrd", memrd 978 | let _cells = [ memrd ] |> List.map ~f:W.cell_implementation 979 | end 980 | 981 | (* 'memory -nomap; opt; clean' *) 982 | module Mem = struct 983 | module P = struct 984 | type 'a t = 985 | { abits : 'a [@rtlname "ABITS"] 986 | ; init : 'a [@rtlname "INIT"] 987 | ; memid : 'a [@rtlname "MEMID"] 988 | ; offset : 'a [@rtlname "OFFSET"] 989 | ; size : 'a [@rtlname "SIZE"] 990 | ; width : 'a [@rtlname "WIDTH"] 991 | ; rd_clk_enable : 'a [@rtlname "RD_CLK_ENABLE"] 992 | ; rd_clk_polarity : 'a [@rtlname "RD_CLK_POLARITY"] 993 | ; rd_ports : 'a [@rtlname "RD_PORTS"] 994 | ; rd_transparent : 'a [@rtlname "RD_TRANSPARENT"] 995 | ; wr_clk_enable : 'a [@rtlname "WR_CLK_ENABLE"] 996 | ; wr_clk_polarity : 'a [@rtlname "WR_CLK_POLARITY"] 997 | ; wr_ports : 'a [@rtlname "WR_PORTS"] 998 | } 999 | [@@deriving hardcaml] 1000 | end 1001 | 1002 | module I = struct 1003 | type 'a t = 1004 | { rd_addr : 'a [@rtlname "RD_ADDR"] 1005 | ; rd_clk : 'a [@rtlname "RD_CLK"] 1006 | ; rd_en : 'a [@rtlname "RD_EN"] 1007 | ; wr_addr : 'a [@rtlname "WR_ADDR"] 1008 | ; wr_clk : 'a [@rtlname "WR_CLK"] 1009 | ; wr_data : 'a [@rtlname "WR_DATA"] 1010 | ; wr_en : 'a [@rtlname "WR_EN"] 1011 | } 1012 | [@@deriving hardcaml] 1013 | end 1014 | 1015 | module O = struct 1016 | type 'a t = { rd_data : 'a [@rtlname "RD_DATA"] } [@@deriving hardcaml] 1017 | end 1018 | 1019 | module W = Implement_cell (P) (I) (O) 1020 | 1021 | let get_input_base_width p = 1022 | I. 1023 | { rd_addr = p.P.abits 1024 | ; rd_clk = 1 1025 | ; rd_en = 1 1026 | ; wr_addr = p.P.abits 1027 | ; wr_clk = 1 1028 | ; wr_data = p.P.width 1029 | ; wr_en = p.P.width 1030 | } 1031 | ;; 1032 | 1033 | let get_input_ports p = 1034 | I. 1035 | { rd_addr = p.P.rd_ports 1036 | ; rd_clk = p.P.rd_ports 1037 | ; rd_en = p.P.rd_ports 1038 | ; wr_addr = p.P.wr_ports 1039 | ; wr_clk = p.P.wr_ports 1040 | ; wr_data = p.P.wr_ports 1041 | ; wr_en = p.P.wr_ports 1042 | } 1043 | ;; 1044 | 1045 | let _get_input_width p = I.(map2 ~f:( * ) (get_input_base_width p) (get_input_ports p)) 1046 | let get_output_base_width p = O.{ rd_data = p.P.width } 1047 | let get_output_ports p = O.{ rd_data = p.P.rd_ports } 1048 | 1049 | let __get_output_width p = 1050 | O.(map2 ~f:( * ) (get_output_base_width p) (get_output_ports p)) 1051 | ;; 1052 | 1053 | let i_to_arrays p i = 1054 | let bwidth = get_input_base_width p in 1055 | let ports = get_input_ports p in 1056 | let to_array x (ports, bwidth) = 1057 | assert (width x = ports * bwidth); 1058 | Array.init ports ~f:(fun j -> 1059 | let l = j * bwidth in 1060 | x.:[l + bwidth - 1, l]) 1061 | in 1062 | I.(map2 ~f:to_array i (zip ports bwidth)) 1063 | ;; 1064 | 1065 | let get_wren_bits p (cell : Cell.t) = 1066 | let wren = find_exn cell.inputs "WR_EN" in 1067 | let wren = Array.of_list @@ wren in 1068 | Array.init p.P.wr_ports ~f:(fun j -> 1069 | Array.sub wren ~pos:(p.P.width * j) ~len:p.P.width) 1070 | ;; 1071 | 1072 | let mem cell p i = 1073 | let p = 1074 | P.map 1075 | ~f:(fun p -> 1076 | try pint p with 1077 | | _ -> 0) 1078 | p 1079 | in 1080 | let i = i_to_arrays p i in 1081 | let module L = 1082 | Lvt.Make_wren (struct 1083 | let dbits = p.P.width 1084 | let abits = p.P.abits 1085 | let size = p.P.size 1086 | end) 1087 | in 1088 | let layout = get_wren_bits p cell in 1089 | let bit x i = (x lsr i) land 1 <> 0 in 1090 | let get_read_mode r = 1091 | match bit p.P.rd_clk_enable r, bit p.P.rd_transparent r with 1092 | | true, true -> `sync_wbr 1093 | | true, false -> `sync_rbw 1094 | | false, true -> `async_wbr 1095 | | false, false -> `async_rbw 1096 | in 1097 | let offset addr = if p.P.offset = 0 then addr else addr -:. p.P.offset in 1098 | let wr_clk w = 1099 | if not (bit p.P.wr_clk_enable w) 1100 | then 1101 | failwith 1102 | ("memory write port is not synchronous: " 1103 | ^ cell.instance_name 1104 | ^ " port " 1105 | ^ Int.to_string w) 1106 | else i.I.wr_clk.(w) 1107 | in 1108 | let spec clk clk_polarity = 1109 | Reg_spec.create ~clock:clk ~clock_edge:(if clk_polarity then Rising else Falling) () 1110 | in 1111 | let rd_port r = 1112 | { Lvt.reg_spec = spec i.I.rd_clk.(r) (bit p.P.rd_clk_polarity r) 1113 | ; rd = { ra = offset i.I.rd_addr.(r); re = i.I.rd_en.(r) } 1114 | ; mode = get_read_mode r 1115 | } 1116 | in 1117 | let wr_port w = 1118 | let wspec = spec (wr_clk w) (bit p.P.wr_clk_polarity w) in 1119 | { Lvt.ram_spec = wspec 1120 | ; reg_spec = wspec 1121 | ; wr = { we = i.I.wr_en.(w); wa = offset i.I.wr_addr.(w); d = i.I.wr_data.(w) } 1122 | } 1123 | in 1124 | let q = 1125 | L.memory 1126 | ~layout 1127 | ~rd:(Array.init p.P.rd_ports ~f:rd_port) 1128 | ~wr:(Array.init p.P.wr_ports ~f:wr_port) 1129 | in 1130 | O.{ rd_data = concat_lsb @@ Array.to_list q } 1131 | ;; 1132 | 1133 | let mem = "$mem", mem 1134 | let cells = [ mem ] |> List.map ~f:W.cell_implementation 1135 | end 1136 | 1137 | let cells = 1138 | List.concat 1139 | [ Op1.cells 1140 | ; Op2.cells 1141 | ; Fa.cells 1142 | ; Lcu.cells 1143 | ; Fa.cells 1144 | ; Slice.cells 1145 | ; Mux.cells 1146 | ; Pmux.cells 1147 | ; Lut.cells 1148 | ; Dff.cells 1149 | ; Dffe.cells 1150 | ; Dffsr.cells 1151 | ; Adff.cells 1152 | ; Concat.cells 1153 | (*(Memwr.cells) 1154 | (Memrd.cells) *) 1155 | ; Mem.cells 1156 | ] 1157 | ;; 1158 | 1159 | let blackboxes = 1160 | [ "shfitx" 1161 | ; "macc" 1162 | ; "div" 1163 | ; "mod" 1164 | ; "pow" 1165 | ; "alu" 1166 | ; "tribuf" 1167 | ; "assert" 1168 | ; "assume" 1169 | ; "equiv" 1170 | ; "sr" 1171 | ; "dlatch" 1172 | ; "dlatchsr" 1173 | ; "memrd" 1174 | ; "memwr" 1175 | ; "meminit" 1176 | ] 1177 | ;; 1178 | 1179 | let find cells name = 1180 | let rec f = function 1181 | | [] -> None 1182 | | { Cell_implementation.name = n; create_fn } :: tl -> 1183 | if String.equal n name then Some create_fn else f tl 1184 | in 1185 | f cells 1186 | ;; 1187 | -------------------------------------------------------------------------------- /src/techlib.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | open Hardcaml 3 | module Cell = Netlist.Cell 4 | module Port = Netlist.Port 5 | 6 | module Cell_implementation : sig 7 | type create_fn = 8 | Cell.t -> Parameter.t list -> Signal.t Port.t list -> Signal.t Port.t list Or_error.t 9 | 10 | type t = 11 | { name : string 12 | ; create_fn : create_fn 13 | } 14 | end 15 | 16 | (** Names of black boxes in the techlib. These are cells we haven't yet implemented. *) 17 | val blackboxes : string list 18 | 19 | (** List of cells in the techlib *) 20 | val cells : Cell_implementation.t list 21 | 22 | (** Find a cell in the techlib *) 23 | val find : Cell_implementation.t list -> string -> Cell_implementation.create_fn option 24 | -------------------------------------------------------------------------------- /src/verilog_circuit.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | module Bus = Netlist.Bus 3 | module Cell = Netlist.Cell 4 | module Port = Netlist.Port 5 | 6 | type t = 7 | { module_name : string 8 | ; inputs : int Port.t list 9 | ; outputs : int Port.t list 10 | ; create_fn : 11 | (Hardcaml.Signal.t Port.t list -> Hardcaml.Signal.t Port.t list Or_error.t 12 | [@sexp.opaque]) 13 | } 14 | [@@deriving sexp_of, fields ~getters] 15 | 16 | let cell_outputs bus_map (cell : Cell.t) = 17 | List.filter_map cell.outputs ~f:(fun port -> 18 | Circuit_bus_map.wire_of_cell_output bus_map cell port) 19 | |> Or_error.all 20 | ;; 21 | 22 | let cell_inputs bus_map (cell : Cell.t) = 23 | List.filter_map cell.inputs ~f:(fun port -> 24 | Circuit_bus_map.signal_of_bus_if_not_empty bus_map port) 25 | |> Or_error.all 26 | ;; 27 | 28 | let instantiate_cell_not_in_techlib (bus_map : Circuit_bus_map.t) (cell : Cell.t) = 29 | (* Create the inputs and outputs of each cell from the bus map. Filter completely empty 30 | ports. *) 31 | let%bind.Or_error inputs = cell_inputs bus_map cell in 32 | let%bind.Or_error outputs = cell_outputs bus_map cell in 33 | let inst = 34 | Hardcaml.Instantiation.create 35 | ~name:cell.module_name 36 | ~instance:cell.instance_name 37 | ~parameters:cell.parameters 38 | ~inputs:(List.map inputs ~f:(fun { Port.name; value } -> name, value)) 39 | ~outputs: 40 | (List.map outputs ~f:(fun { Port.name; value } -> 41 | name, Hardcaml.Signal.width value)) 42 | () 43 | in 44 | (* Attach cell outputs to their wires *) 45 | List.iter outputs ~f:(fun { name; value = signal } -> 46 | Hardcaml.Signal.( <-- ) signal (Hardcaml.Instantiation.output inst name)); 47 | Ok () 48 | ;; 49 | 50 | let assign_cell_outputs 51 | cell 52 | (cell_outputs : Hardcaml.Signal.t Port.t list) 53 | (implementation_outputs : Hardcaml.Signal.t Port.t list) 54 | = 55 | let find name = 56 | match List.find cell_outputs ~f:(fun cell -> String.equal cell.name name) with 57 | | None -> 58 | Or_error.error_s 59 | [%message 60 | "Failed to associate cell output port with signal" 61 | (name : string) 62 | (cell : Cell.t)] 63 | | Some s -> Ok s 64 | in 65 | let%bind.Or_error () = 66 | List.map implementation_outputs ~f:(fun implementation_output -> 67 | let%bind.Or_error cell_output = find implementation_output.name in 68 | Hardcaml.Signal.( <-- ) cell_output.value implementation_output.value; 69 | Ok ()) 70 | |> Or_error.all_unit 71 | in 72 | Ok () 73 | ;; 74 | 75 | let instantiate_cell bus_map (cell : Cell.t) = 76 | match Techlib.find Techlib.cells cell.module_name with 77 | | None -> instantiate_cell_not_in_techlib bus_map cell 78 | | Some (cell_implementation : Techlib.Cell_implementation.create_fn) -> 79 | let%bind.Or_error inputs = cell_inputs bus_map cell in 80 | let%bind.Or_error cell_outputs = cell_outputs bus_map cell in 81 | let%bind.Or_error implementation_outputs = 82 | cell_implementation cell cell.parameters inputs 83 | in 84 | let%bind.Or_error () = assign_cell_outputs cell cell_outputs implementation_outputs in 85 | Ok () 86 | ;; 87 | 88 | let instantiate_cells bus_map cells = 89 | List.map cells ~f:(instantiate_cell bus_map) |> Or_error.all_unit 90 | ;; 91 | 92 | let create_circuit_outputs bus_map (outputs : Bus.t Port.t list) = 93 | List.map outputs ~f:(fun port -> 94 | match Circuit_bus_map.signal_of_bus_if_not_empty bus_map port with 95 | | Some port -> port 96 | | None -> 97 | Or_error.error_s 98 | [%message "Cannot construct bus for top level output port" (port : Bus.t Port.t)]) 99 | |> Or_error.all 100 | ;; 101 | 102 | let create netlist ~top_name = 103 | let%bind.Or_error top = Netlist.find_module_by_name netlist top_name in 104 | let create_fn circuit_inputs = 105 | (* Add circuit inputs and cell outputs to a map of signal drivers. *) 106 | let%bind.Or_error bus_map = Circuit_bus_map.create top ~circuit_inputs in 107 | (* Create instantiations for all cells, connecting inputs and outputs *) 108 | let%bind.Or_error () = instantiate_cells bus_map top.cells in 109 | (* Construct circuit outputs *) 110 | let%bind.Or_error outputs = create_circuit_outputs bus_map top.outputs in 111 | Ok outputs 112 | in 113 | let to_port (p : _ Port.t) = { p with value = List.length p.value } in 114 | Ok 115 | { module_name = top.name 116 | ; inputs = List.map top.inputs ~f:to_port 117 | ; outputs = List.map top.outputs ~f:to_port 118 | ; create_fn 119 | } 120 | ;; 121 | 122 | let to_hardcaml_circuit t = 123 | let create_fn = create_fn t in 124 | let inputs = 125 | List.map (inputs t) ~f:(fun { Port.name; value = width } -> 126 | { Port.name; value = Hardcaml.Signal.input name width }) 127 | in 128 | let%bind.Or_error outputs = create_fn inputs in 129 | let outputs = 130 | List.map outputs ~f:(fun { Port.name; value } -> Hardcaml.Signal.output name value) 131 | in 132 | try Ok (Hardcaml.Circuit.create_exn ~name:t.module_name outputs) with 133 | | e -> 134 | Or_error.error_s 135 | [%message "Failed to convert verilog design to a hardcaml circuit" (e : exn)] 136 | ;; 137 | -------------------------------------------------------------------------------- /src/verilog_circuit.mli: -------------------------------------------------------------------------------- 1 | (** A data structure representing the hardcaml implementation of a [Verilog_design.t] 2 | converted to a [Netlist.t]. *) 3 | 4 | open Base 5 | module Port = Netlist.Port 6 | 7 | type t [@@deriving sexp_of] 8 | 9 | val create : Netlist.t -> top_name:string -> t Or_error.t 10 | val inputs : t -> int Port.t list 11 | val outputs : t -> int Port.t list 12 | 13 | val create_fn 14 | : t 15 | -> Hardcaml.Signal.t Port.t list 16 | -> Hardcaml.Signal.t Port.t list Or_error.t 17 | 18 | val to_hardcaml_circuit : t -> Hardcaml.Circuit.t Or_error.t 19 | -------------------------------------------------------------------------------- /src/verilog_design.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Parameter = struct 4 | type t = Hardcaml.Parameter.t [@@deriving equal] 5 | 6 | type simple_parameter = Hardcaml.Parameter_name.t * Hardcaml.Parameter.Value.t 7 | [@@deriving sexp] 8 | 9 | let sexp_of_t (t : Hardcaml.Parameter.t) = sexp_of_simple_parameter (t.name, t.value) 10 | 11 | let t_of_sexp s = 12 | let name, value = simple_parameter_of_sexp s in 13 | { Hardcaml.Parameter.name; value } 14 | ;; 15 | 16 | let create = Hardcaml.Parameter.create 17 | let name { Hardcaml.Parameter.name; value = _ } = Hardcaml.Parameter_name.to_string name 18 | let value { Hardcaml.Parameter.name = _; value } = value 19 | 20 | let string_of_value { Hardcaml.Parameter.name = _; value } = 21 | match value with 22 | | Int i -> Int.to_string i 23 | | String s -> "\"" ^ s ^ "\"" 24 | | _ -> 25 | raise_s [%message "Invalid parameter type" (value : Hardcaml.Parameter.Value.t)] 26 | ;; 27 | end 28 | 29 | module Parameters = struct 30 | type t = Parameter.t list [@@deriving sexp, equal] 31 | 32 | let rec replace (t : t) (parameter : Parameter.t) = 33 | match t with 34 | | [] -> [] 35 | | hd :: tl -> 36 | if Hardcaml.Parameter_name.equal hd.name parameter.name 37 | then parameter :: tl 38 | else hd :: replace tl parameter 39 | ;; 40 | 41 | let replace t ~with_ = List.fold with_ ~init:t ~f:(fun ps p -> replace ps p) 42 | end 43 | 44 | module Define_value = struct 45 | type t = 46 | | String of string 47 | | Int of int 48 | | No_arg 49 | [@@deriving sexp, equal] 50 | 51 | let to_string = function 52 | | Int i -> Int.to_string i 53 | | String s -> (* strings are not quoted in defines *) s 54 | | No_arg -> raise_s [%message "Cannot convert [Define_value.No_arg] to string"] 55 | ;; 56 | end 57 | 58 | module Define = struct 59 | type t = 60 | { name : string 61 | ; value : Define_value.t 62 | } 63 | [@@deriving equal, fields ~getters] 64 | 65 | type simple_define = string * Define_value.t [@@deriving sexp] 66 | 67 | let sexp_of_t (t : t) = sexp_of_simple_define (t.name, t.value) 68 | 69 | let t_of_sexp s = 70 | let name, value = simple_define_of_sexp s in 71 | { name; value } 72 | ;; 73 | 74 | let create ~name ~value = { name; value } 75 | end 76 | 77 | module Defines = struct 78 | type t = Define.t list [@@deriving sexp, equal] 79 | end 80 | 81 | module Path = struct 82 | type t = string [@@deriving sexp, equal] 83 | end 84 | 85 | module Module = struct 86 | type t = 87 | { module_name : string 88 | ; path : Path.t 89 | ; instantiates : t list [@sexp.default []] 90 | ; parameters : Parameters.t [@sexp.default []] 91 | ; blackbox : bool [@sexp.default false] 92 | } 93 | [@@deriving sexp, fields ~getters] 94 | 95 | let create 96 | ?(blackbox = false) 97 | ?(parameters = []) 98 | ?(instantiates = []) 99 | ~module_name 100 | ~path 101 | () 102 | = 103 | { module_name; path; instantiates; parameters; blackbox } 104 | ;; 105 | 106 | let override ?module_name ?path ?instantiates ?parameters ?blackbox t = 107 | let module_name = Option.value module_name ~default:t.module_name in 108 | let path = Option.value path ~default:t.path in 109 | let instantiates = Option.value instantiates ~default:t.instantiates in 110 | let parameters = Option.value parameters ~default:t.parameters in 111 | let blackbox = Option.value blackbox ~default:t.blackbox in 112 | create ~module_name ~path ~instantiates ~parameters ~blackbox () 113 | ;; 114 | 115 | let rec iter t ~f = 116 | List.iter (instantiates t) ~f:(fun t -> iter t ~f); 117 | f t 118 | ;; 119 | 120 | let rec map t ~f = 121 | f { t with instantiates = List.map (instantiates t) ~f:(fun t -> map t ~f) } 122 | ;; 123 | 124 | let rec flat_map t ~f = 125 | let x = List.map (instantiates t) ~f:(fun t -> flat_map t ~f) |> List.concat in 126 | f t :: x 127 | ;; 128 | end 129 | 130 | type t = 131 | { top : Module.t 132 | ; defines : Defines.t [@sexp.default []] 133 | } 134 | [@@deriving sexp, fields ~getters] 135 | 136 | let create ?(defines = []) ~top () = { top; defines } 137 | let top_name t = t.top.module_name 138 | let override_parameters t parameters = { t with top = Module.override ~parameters t.top } 139 | 140 | let map_paths t ~f = 141 | { t with 142 | top = Module.map t.top ~f:(fun m -> Module.override ~path:(f (Module.path m)) m) 143 | } 144 | ;; 145 | 146 | module type Crunched = sig 147 | val read : string -> string option 148 | end 149 | 150 | let find_in_crunched crunched path = 151 | List.find_map crunched ~f:(fun (module Crunched : Crunched) -> Crunched.read path) 152 | |> Option.value_exn 153 | ~error: 154 | (Error.create_s [%message "Unable to extract crunched file" (path : string)]) 155 | ;; 156 | 157 | let map_crunched_paths ?(delete_temp_files = true) crunched t = 158 | let seen = Hashtbl.create (module String) in 159 | map_paths t ~f:(fun path -> 160 | match Hashtbl.find seen path with 161 | | Some path -> path 162 | | None -> 163 | let tmp_file = Filename_unix.temp_file "crunched" ".v" in 164 | if delete_temp_files then Stdlib.at_exit (fun () -> Unix.unlink tmp_file); 165 | let data = find_in_crunched crunched path in 166 | Stdio.Out_channel.write_all tmp_file ~data; 167 | Hashtbl.set seen ~key:path ~data:tmp_file; 168 | tmp_file) 169 | ;; 170 | 171 | module type Embedded_files = sig 172 | val by_filename : (string * string) list 173 | end 174 | 175 | let find_in_embedded_files embedded_files path = 176 | (* embed file strips any leading path out. *) 177 | let file = Stdlib.Filename.basename path in 178 | match 179 | List.find_map embedded_files ~f:(fun (module Embedded_files : Embedded_files) -> 180 | List.Assoc.find Embedded_files.by_filename file ~equal:String.equal) 181 | with 182 | | None -> raise_s [%message "Unable to extract crunched file" (path : string)] 183 | | Some data -> data 184 | ;; 185 | 186 | let map_embed_file_paths ?(delete_temp_files = true) embedded_files t = 187 | let seen = Hashtbl.create (module String) in 188 | map_paths t ~f:(fun path -> 189 | match Hashtbl.find seen path with 190 | | Some path -> path 191 | | None -> 192 | let tmp_file = Filename_unix.temp_file "crunched" ".v" in 193 | if delete_temp_files then Stdlib.at_exit (fun () -> Unix.unlink tmp_file); 194 | let data = find_in_embedded_files embedded_files path in 195 | Stdio.Out_channel.write_all tmp_file ~data; 196 | Hashtbl.set seen ~key:path ~data:tmp_file; 197 | tmp_file) 198 | ;; 199 | -------------------------------------------------------------------------------- /src/verilog_design.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Parameter : sig 4 | type t = Hardcaml.Parameter.t [@@deriving sexp, equal] 5 | 6 | val create : name:string -> value:Hardcaml.Parameter.Value.t -> t 7 | val name : t -> string 8 | val value : t -> Hardcaml.Parameter.Value.t 9 | val string_of_value : t -> string 10 | end 11 | 12 | module Parameters : sig 13 | type t = Parameter.t list [@@deriving sexp] 14 | 15 | val replace : t -> with_:t -> t 16 | end 17 | 18 | module Define_value : sig 19 | type t = 20 | | String of string 21 | | Int of int 22 | | No_arg 23 | [@@deriving sexp, equal] 24 | 25 | val to_string : t -> string 26 | end 27 | 28 | module Define : sig 29 | type t [@@deriving sexp, equal] 30 | 31 | val create : name:string -> value:Define_value.t -> t 32 | val name : t -> string 33 | val value : t -> Define_value.t 34 | end 35 | 36 | module Defines : sig 37 | type t = Define.t list [@@deriving sexp] 38 | end 39 | 40 | module Module : sig 41 | type t [@@deriving sexp] 42 | 43 | val create 44 | : ?blackbox:bool 45 | -> ?parameters:Parameters.t 46 | -> ?instantiates:t list 47 | -> module_name:string 48 | -> path:string 49 | -> unit 50 | -> t 51 | 52 | val override 53 | : ?module_name:string 54 | -> ?path:string 55 | -> ?instantiates:t list 56 | -> ?parameters:Parameters.t 57 | -> ?blackbox:bool 58 | -> t 59 | -> t 60 | 61 | val blackbox : t -> bool 62 | val parameters : t -> Parameters.t 63 | val module_name : t -> string 64 | val path : t -> string 65 | val instantiates : t -> t list 66 | 67 | (** {2 Iterators} 68 | 69 | Depth first and call [f] from the leaves towards the root of the hierarchy. *) 70 | 71 | val iter : t -> f:(t -> unit) -> unit 72 | val map : t -> f:(t -> t) -> t 73 | 74 | (** Convert to a list. The "top" of the design is at the head of the list. *) 75 | val flat_map : t -> f:(t -> 'a) -> 'a list 76 | end 77 | 78 | type t [@@deriving sexp] 79 | 80 | val create : ?defines:Defines.t -> top:Module.t -> unit -> t 81 | val defines : t -> Defines.t 82 | val top : t -> Module.t 83 | 84 | (** Name of top level module *) 85 | val top_name : t -> string 86 | 87 | (** Override the parameters of the top level module *) 88 | val override_parameters : t -> Parameters.t -> t 89 | 90 | (** [map_paths t ~f] applies [f] to each modules path *) 91 | val map_paths : t -> f:(string -> string) -> t 92 | 93 | module type Crunched = sig 94 | val read : string -> string option 95 | end 96 | 97 | (** Read verilog files from [ocaml-cruch]ed file system(s) and extract to temp files. *) 98 | val map_crunched_paths : ?delete_temp_files:bool -> (module Crunched) list -> t -> t 99 | 100 | module type Embedded_files = sig 101 | val by_filename : (string * string) list 102 | end 103 | 104 | (** Read verilog files from [embed_file] file system(s) and extract to temp files. *) 105 | val map_embed_file_paths 106 | : ?delete_temp_files:bool 107 | -> (module Embedded_files) list 108 | -> t 109 | -> t 110 | -------------------------------------------------------------------------------- /src/with_interface.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Make (I : Hardcaml.Interface.S) (O : Hardcaml.Interface.S) = struct 4 | let inputs (i : _ I.t) = 5 | I.map2 I.port_names i ~f:(fun name signal -> 6 | { Verilog_circuit.Port.name; value = signal }) 7 | |> I.to_list 8 | ;; 9 | 10 | let outputs (o : _ Verilog_circuit.Port.t list) = 11 | Or_error.try_with (fun () -> 12 | O.map O.port_names ~f:(fun port -> (Verilog_circuit.Port.find_exn o port).value)) 13 | ;; 14 | 15 | let create ?verbose ?passes verilog_design = 16 | let%bind.Or_error netlist = Netlist.create ?verbose ?passes verilog_design in 17 | let%bind.Or_error circuit = 18 | Verilog_circuit.create netlist ~top_name:(Verilog_design.top_name verilog_design) 19 | in 20 | let create_fn = Verilog_circuit.create_fn circuit in 21 | Ok 22 | (fun i -> 23 | let inputs = inputs i in 24 | let%bind.Or_error o = create_fn inputs in 25 | outputs o) 26 | ;; 27 | end 28 | -------------------------------------------------------------------------------- /src/with_interface.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Make (I : Hardcaml.Interface.S) (O : Hardcaml.Interface.S) : sig 4 | val create 5 | : ?verbose:bool 6 | -> ?passes:Pass.t list 7 | -> Verilog_design.t 8 | -> (Hardcaml.Signal.t I.t -> Hardcaml.Signal.t O.t Or_error.t) Or_error.t 9 | end 10 | -------------------------------------------------------------------------------- /src/yosys_netlist.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Jsonaf.Export 3 | 4 | module Int_or_string = struct 5 | type t = 6 | | Int of int 7 | | String of string 8 | [@@deriving sexp_of] 9 | 10 | let t_of_jsonaf t = 11 | match Jsonaf.int t with 12 | | Some i -> Int i 13 | | None -> 14 | (match Jsonaf.string t with 15 | | Some s -> String s 16 | | None -> raise_s [%message "Int or String value expected" (t : Jsonaf.t)]) 17 | ;; 18 | 19 | let jsonaf_of_t = function 20 | | Int i -> jsonaf_of_int i 21 | | String s -> jsonaf_of_string s 22 | ;; 23 | end 24 | 25 | module type Assoc_list = sig 26 | type v 27 | 28 | type t = 29 | { name : string 30 | ; value : v 31 | } 32 | [@@deriving sexp_of] 33 | end 34 | 35 | module Assoc_list (V : sig 36 | type t [@@deriving jsonaf, sexp_of] 37 | end) = 38 | struct 39 | type t = 40 | { name : string 41 | ; value : V.t 42 | } 43 | [@@deriving sexp_of] 44 | 45 | module List = struct 46 | type nonrec t = t list [@@deriving sexp_of] 47 | 48 | let t_of_jsonaf t : t = 49 | Jsonaf.assoc_list_exn t 50 | |> List.map ~f:(fun (name, v) -> { name; value = V.t_of_jsonaf v }) 51 | ;; 52 | 53 | let jsonaf_of_t (t : t) = 54 | `Object (List.map t ~f:(fun t -> t.name, V.jsonaf_of_t t.value)) 55 | ;; 56 | end 57 | end 58 | 59 | module Direction = struct 60 | type t = 61 | | Input 62 | | Output 63 | [@@deriving sexp_of, equal] 64 | 65 | let t_of_jsonaf t = 66 | match Jsonaf.string t with 67 | | None -> raise_s [%message "Expecting JSON string for direction"] 68 | | Some "input" -> Input 69 | | Some "output" -> Output 70 | | _ as direction -> raise_s [%message "Invalid direction" (direction : string option)] 71 | ;; 72 | 73 | let jsonaf_of_t = function 74 | | Input -> jsonaf_of_string "input" 75 | | Output -> jsonaf_of_string "output" 76 | ;; 77 | end 78 | 79 | module Bit = struct 80 | type t = 81 | | Vdd 82 | | Gnd 83 | | X 84 | | Index of int 85 | [@@deriving compare, sexp_of] 86 | 87 | let t_of_jsonaf t = 88 | match Int_or_string.t_of_jsonaf t with 89 | | String "0" -> Gnd 90 | | String "1" -> Vdd 91 | | String "x" | String "X" -> X 92 | | String s -> raise_s [%message "Invalid bit value" (s : string)] 93 | | Int i -> Index i 94 | ;; 95 | 96 | let jsonaf_of_t = function 97 | | Gnd -> jsonaf_of_string "0" 98 | | Vdd -> jsonaf_of_string "1" 99 | | X -> jsonaf_of_string "x" 100 | | Index i -> jsonaf_of_int i 101 | ;; 102 | end 103 | 104 | module Port = struct 105 | module V = struct 106 | type t = 107 | { direction : Direction.t 108 | ; bits : Bit.t list 109 | } 110 | [@@deriving jsonaf, sexp_of] 111 | end 112 | 113 | include Assoc_list (V) 114 | end 115 | 116 | module Parameter = struct 117 | module V = struct 118 | type t = Int_or_string.t [@@deriving jsonaf, sexp_of] 119 | end 120 | 121 | include Assoc_list (V) 122 | end 123 | 124 | module Connection = struct 125 | module V = struct 126 | type t = Bit.t list [@@deriving jsonaf, sexp_of] 127 | end 128 | 129 | include Assoc_list (V) 130 | end 131 | 132 | module Port_direction = struct 133 | module V = struct 134 | type t = Direction.t [@@deriving jsonaf, sexp_of] 135 | end 136 | 137 | include Assoc_list (V) 138 | end 139 | 140 | module Cell = struct 141 | module V = struct 142 | type t = 143 | { hide_name : int [@jsonaf.default 1] 144 | ; module_name : string [@key "type"] 145 | ; parameters : Parameter.List.t [@jsonaf.default []] 146 | ; port_directions : Port_direction.List.t [@jsonaf.default []] 147 | ; connections : Connection.List.t [@jsonaf.default []] 148 | } 149 | [@@deriving jsonaf, sexp_of] [@@jsonaf.allow_extra_fields] 150 | end 151 | 152 | include Assoc_list (V) 153 | end 154 | 155 | module Netname = struct 156 | module V = struct 157 | type t = 158 | { hide_name : int 159 | ; bits : Bit.t list 160 | } 161 | [@@deriving jsonaf, sexp_of] [@@jsonaf.allow_extra_fields] 162 | end 163 | 164 | include Assoc_list (V) 165 | end 166 | 167 | module Module = struct 168 | module V = struct 169 | type t = 170 | { ports : Port.List.t [@jsonaf.default []] 171 | ; cells : Cell.List.t [@jsonaf.default []] 172 | ; netnames : Netname.List.t [@jsonaf.default []] 173 | } 174 | [@@deriving jsonaf, sexp_of] [@@jsonaf.allow_extra_fields] 175 | end 176 | 177 | include Assoc_list (V) 178 | end 179 | 180 | type t = 181 | { creator : string 182 | ; modules : Module.List.t 183 | } 184 | [@@deriving jsonaf, sexp_of] [@@jsonaf.allow_extra_fields] 185 | 186 | let of_string s = 187 | let%bind.Or_error json = Jsonaf.parse s in 188 | Or_error.try_with (fun () -> t_of_jsonaf json) 189 | ;; 190 | 191 | let to_string n = Jsonaf.to_string (jsonaf_of_t n) 192 | let to_string_hum n = Jsonaf.to_string_hum (jsonaf_of_t n) 193 | 194 | let find_module_by_name t name = 195 | List.find t.modules ~f:(fun m -> String.equal name m.name) 196 | ;; 197 | -------------------------------------------------------------------------------- /src/yosys_netlist.mli: -------------------------------------------------------------------------------- 1 | (** Raw json netlist representation parsed with [jsonaf]. See [Netlist] for a cleaned up 2 | version. *) 3 | 4 | open Base 5 | 6 | module type Assoc_list = sig 7 | type v 8 | 9 | type t = 10 | { name : string 11 | ; value : v 12 | } 13 | [@@deriving sexp_of] 14 | end 15 | 16 | module Assoc_list (V : sig 17 | type t [@@deriving jsonaf, sexp_of] 18 | end) : Assoc_list with type v := V.t 19 | 20 | module Int_or_string : sig 21 | type t = 22 | | Int of int 23 | | String of string 24 | [@@deriving jsonaf, sexp_of] 25 | end 26 | 27 | module Direction : sig 28 | type t = 29 | | Input 30 | | Output 31 | [@@deriving equal, jsonaf, sexp_of] 32 | end 33 | 34 | module Bit : sig 35 | type t = 36 | | Vdd 37 | | Gnd 38 | | X 39 | | Index of int 40 | [@@deriving compare, jsonaf, sexp_of] 41 | end 42 | 43 | module Port : sig 44 | module V : sig 45 | type t = 46 | { direction : Direction.t 47 | ; bits : Bit.t list 48 | } 49 | [@@deriving jsonaf, sexp_of] 50 | end 51 | 52 | include Assoc_list with type v := V.t 53 | end 54 | 55 | module Parameter : sig 56 | module V : sig 57 | type t = Int_or_string.t [@@deriving jsonaf, sexp_of] 58 | end 59 | 60 | include Assoc_list with type v := V.t 61 | end 62 | 63 | module Connection : sig 64 | module V : sig 65 | type t = Bit.t list [@@deriving jsonaf, sexp_of] 66 | end 67 | 68 | include Assoc_list with type v := V.t 69 | end 70 | 71 | module Port_direction : sig 72 | module V : sig 73 | type t = Direction.t [@@deriving jsonaf, sexp_of] 74 | end 75 | 76 | include Assoc_list with type v := V.t 77 | end 78 | 79 | module Cell : sig 80 | module V : sig 81 | type t = 82 | { hide_name : int 83 | ; module_name : string 84 | ; parameters : Parameter.t list 85 | ; port_directions : Port_direction.t list 86 | ; connections : Connection.t list 87 | } 88 | [@@deriving jsonaf, sexp_of] 89 | end 90 | 91 | include Assoc_list with type v := V.t 92 | end 93 | 94 | module Netname : sig 95 | module V : sig 96 | type t = 97 | { hide_name : int 98 | ; bits : Bit.t list 99 | } 100 | end 101 | 102 | include Assoc_list with type v := V.t 103 | end 104 | 105 | module Module : sig 106 | module V : sig 107 | type t = 108 | { ports : Port.t list 109 | ; cells : Cell.t list 110 | ; netnames : Netname.t list 111 | } 112 | [@@deriving jsonaf, sexp_of] 113 | end 114 | 115 | include Assoc_list with type v := V.t 116 | end 117 | 118 | type t = 119 | { creator : string 120 | ; modules : Module.t list 121 | } 122 | [@@deriving jsonaf, sexp_of] 123 | 124 | (** Parse a string containing json into a [Yosys_netlist]. *) 125 | val of_string : string -> t Or_error.t 126 | 127 | (** Convert a [Yosys_netlist] to a json string ([_hum] is with indentation) *) 128 | val to_string : t -> string 129 | 130 | val to_string_hum : t -> string 131 | 132 | (** Lookup a module in the netlist. *) 133 | val find_module_by_name : t -> string -> Module.t option 134 | -------------------------------------------------------------------------------- /test/apps/mram.ml: -------------------------------------------------------------------------------- 1 | open Hardcaml 2 | open Signal 3 | open Hardcaml_of_verilog 4 | module Cs = Cyclesim 5 | module S = Cyclesim 6 | module Waveterm_waves = Hardcaml_waveterm.Waves 7 | module Waveterm_sim = Hardcaml_waveterm.Sim 8 | module Waveterm_widget = Hardcaml_waveterm_interactive.Widget 9 | 10 | (* configuration *) 11 | 12 | let n_cycles = ref 1000 13 | let abits = ref 4 14 | let dbits = ref 8 15 | let nwr = ref 2 16 | let nrd = ref 2 17 | let random_re = ref true 18 | let mode : [ `alternate | Lvt.mode ] ref = ref `alternate 19 | let vlog = ref false 20 | let no_waves = ref false 21 | 22 | let _ = 23 | Arg.( 24 | parse 25 | [ "-n", Set_int n_cycles, "Number of cycles to simulate (default: 1000)" 26 | ; "-a", Set_int abits, "address bits (default: 4)" 27 | ; "-d", Set_int dbits, "data bits (default: 8)" 28 | ; "-rd", Set_int nrd, "read ports (default: 2)" 29 | ; "-wr", Set_int nwr, "write ports (default: 2)" 30 | ; "-no-re", Clear random_re, "disable random read-enable toggling (default: false)" 31 | ; "-sync-rbw", Unit (fun () -> mode := `sync_rbw), "Put all ports in sync_rbw mode" 32 | ; "-sync-wbr", Unit (fun () -> mode := `sync_wbr), "Put all ports in sync_wbr mode" 33 | ; ( "-async-rbw" 34 | , Unit (fun () -> mode := `async_rbw) 35 | , "Put all ports in async_rbw mode" ) 36 | ; ( "-async-wbr" 37 | , Unit (fun () -> mode := `async_wbr) 38 | , "Put all ports in async_wbr mode" ) 39 | ; "-vlog", Set vlog, "Dump verilog" 40 | ; "-no-waves", Set no_waves, "Disable waveform view" 41 | ] 42 | (fun _ -> failwith "invalid anon arg") 43 | "LVT Multiport Memory Testbench.Builds memories with N read/M write ports from \ 44 | simpler 1 read/1 write port memories (as available in FPGAs). Requires N*M base \ 45 | memories plus a so called Live Value Table to directs reads to the mostrecently \ 46 | accessed write data.Each port may be set independently in syncronous or \ 47 | asynchronous read mode withread-before-write or write-before-read behaviour (by \ 48 | default the testbench alternates between port modes).For testing the read-enable \ 49 | port may be held constant.") 50 | ;; 51 | 52 | let clock = input "clock" 1 53 | 54 | let testbench_mram () = 55 | let module C = struct 56 | let abits = !abits 57 | let dbits = !dbits 58 | let size = 1 lsl abits 59 | end 60 | in 61 | let nwr = !nwr in 62 | let nrd = !nrd in 63 | let mode = 64 | Array.init nrd (fun i -> 65 | match !mode with 66 | | `alternate -> 67 | (match i mod 4 with 68 | | 0 -> `sync_rbw 69 | | 1 -> `sync_wbr 70 | | 2 -> `async_rbw 71 | | _ -> `async_wbr) 72 | | `sync_rbw -> `sync_rbw 73 | | `sync_wbr -> `sync_wbr 74 | | `async_rbw -> `async_rbw 75 | | `async_wbr -> `async_wbr) 76 | in 77 | let random_re = !random_re in 78 | (*let module M = Memory_regs(C) in*) 79 | let module L = Lvt.Make (C) in 80 | let aname m n = n ^ string_of_int m in 81 | let mk_input m (n, b) = input (aname m n) b in 82 | let wr = Array.init nwr (fun m -> L.Wr.(map ~f:(mk_input m) t)) in 83 | let rd = Array.init nrd (fun m -> L.Rd.(map ~f:(mk_input m) t)) in 84 | let reg_spec = Reg_spec.create () ~clock in 85 | let wr' = 86 | Array.init nwr (fun m -> 87 | { Lvt.ram_spec = Reg_spec.create () ~clock 88 | ; reg_spec = Reg_spec.create () ~clock 89 | ; wr = wr.(m) 90 | }) 91 | in 92 | let rd' = 93 | Array.init nrd (fun m -> 94 | { Lvt.reg_spec = Reg_spec.create () ~clock; rd = rd.(m); mode = mode.(m) }) 95 | in 96 | let q = L.memory ~wr:wr' ~rd:rd' in 97 | let qi = Array.init nrd (fun m -> input (aname m "qi") C.dbits) in 98 | let reg_qr m = 99 | match mode.(m) with 100 | | `sync_wbr -> reg reg_spec ~enable:vdd qi.(m) 101 | | `sync_rbw -> reg reg_spec ~enable:rd.(m).L.Rd.re qi.(m) 102 | | _ -> qi.(m) 103 | in 104 | let qr = Array.init nrd reg_qr in 105 | let qs = 106 | Array.init nrd (fun m -> output (aname m "q") q.(m), output (aname m "qr") qr.(m)) 107 | in 108 | let check = Array.map (fun (q, qr) -> q ==: qr) qs in 109 | let check = Array.mapi (fun m -> output (aname m "check")) check in 110 | let outputs = 111 | (Array.to_list @@ Array.map fst qs) 112 | @ (Array.to_list @@ Array.map snd qs) 113 | @ Array.to_list check 114 | in 115 | let circ = Circuit.create_exn ~name:"mram" outputs in 116 | let sim = Cs.create circ in 117 | let sim, waves = Waveterm_sim.wrap sim in 118 | let rd m = 119 | { L.Rd.ra = S.in_port sim (aname m "ra") 120 | ; re = 121 | (try S.in_port sim (aname m "re") with 122 | | _ -> ref Bits.vdd) 123 | } 124 | in 125 | let wr m = 126 | { L.Wr.wa = S.in_port sim (aname m "wa") 127 | ; we = S.in_port sim (aname m "we") 128 | ; d = S.in_port sim (aname m "d") 129 | } 130 | in 131 | let rd, wr = Array.init nrd rd, Array.init nwr wr in 132 | let qi = Array.init nrd (fun m -> S.in_port sim (aname m "qi")) in 133 | (* random reads and writes *) 134 | let rand (_, b) = b, Random.int (1 lsl b) in 135 | let rand_wr () = L.Wr.(map ~f:rand t) in 136 | let rand_rd () = 137 | if random_re then L.Rd.(map ~f:rand t) else L.Rd.{ (map ~f:rand t) with re = 1, 1 } 138 | in 139 | (* implement the reads and writes *) 140 | let ref_mem = Array.init C.size (fun _ -> 0) in 141 | (* do random reads and writes to the core and a testbench memory *) 142 | let assign a (b, c) = a := Bits.of_int ~width:b c in 143 | let update_write wr = 144 | let wr = L.Wr.(map ~f:snd wr) in 145 | if wr.L.Wr.we = 1 then ref_mem.(wr.L.Wr.wa) <- wr.L.Wr.d 146 | in 147 | let prev_ra = Array.make nrd 0 in 148 | let update_read i rd = 149 | (*let rd = L.Rd.({ map snd rd with L.Rd.re = 1 }) in*) 150 | let rd = L.Rd.(map ~f:snd rd) in 151 | if rd.L.Rd.re = 1 || Lvt.is_async mode.(i) 152 | then ( 153 | qi.(i) := Bits.of_int ~width:C.dbits ref_mem.(rd.L.Rd.ra); 154 | prev_ra.(i) <- rd.L.Rd.ra) 155 | else if mode.(i) = `sync_wbr 156 | then qi.(i) := Bits.of_int ~width:C.dbits ref_mem.(prev_ra.(i)) 157 | in 158 | let perform_reads ft = 159 | let cond = function 160 | | `sync_wbr | `async_wbr -> ft 161 | | _ -> not ft 162 | in 163 | for i = 0 to nrd - 1 do 164 | if cond mode.(i) 165 | then ( 166 | let rd' = rand_rd () in 167 | update_read i rd'; 168 | ignore @@ L.Rd.(map2 ~f:assign rd.(i) rd')) 169 | done 170 | in 171 | let perform_writes () = 172 | for i = 0 to nwr - 1 do 173 | let wr' = rand_wr () in 174 | update_write wr'; 175 | ignore @@ L.Wr.(map2 ~f:assign wr.(i) wr') 176 | done 177 | in 178 | for _ = 1 to !n_cycles do 179 | perform_reads false; 180 | (* non-fallthrough reads *) 181 | perform_writes (); 182 | (* all writes (last takes priority) *) 183 | perform_reads true; 184 | (* fallthrough reads *) 185 | S.cycle sim 186 | done; 187 | if not !no_waves then Waveterm_widget.run Waveterm_waves.{ cfg = Config.default; waves }; 188 | if !vlog then Rtl.print Verilog circ 189 | ;; 190 | 191 | let () = testbench_mram () 192 | -------------------------------------------------------------------------------- /test/apps/mram.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/apps/sat_cells.ml.unused: -------------------------------------------------------------------------------- 1 | #directory "_build/src";; 2 | #require "atdgen,hardcaml";; 3 | #load "Hardcaml_of_verilog.cma";; 4 | 5 | (* 6 | 7 | This program generates miter circuits to prove equivalence of the 8 | yosys cell models to the hardcaml versions using SAT. 9 | 10 | This is done over various parameter combinations so cannot be 11 | totally exhaustive, but with enough testing we can be fairly 12 | confident. 13 | 14 | A verilog file is generated for each test, and an example command 15 | line for yosys is generated. 16 | 17 | *) 18 | 19 | module Test(C : Hardcaml_of_verilog.Techlib.Proof.Cells)(P : sig 20 | val params : int C.P.t list 21 | end) = struct 22 | 23 | module Proof = Hardcaml_of_verilog.Techlib.Proof.Make(C) 24 | 25 | let pint = function Hardcaml.Signal.Types.ParamInt i -> i 26 | | _ -> failwith "expecting int parameter" 27 | 28 | let postfix p = 29 | List.fold_left 30 | (fun a (n,p) -> a ^ "_" ^ n ^ "_" ^ string_of_int p) 31 | "" C.P.(to_list @@ map2 (fun (n,_) p -> n,p) t p) 32 | 33 | let run () = 34 | List.iter 35 | (fun cell -> 36 | List.iter 37 | (fun p -> 38 | try Proof.proof ~path:"test/sat_techlib" ~postfix:(postfix p) p cell 39 | with e -> begin 40 | Printf.fprintf stderr "failed to generate %s%s\n%!" (fst cell) (postfix p); 41 | raise e 42 | end) 43 | P.params) 44 | C.cells 45 | 46 | end 47 | 48 | let n_random_params = 50 49 | let rnd l h = l + Random.int (h-l+1) 50 | 51 | module Op1 = Test(Hardcaml_of_verilog.Techlib.Simlib.Op1)(struct 52 | open Hardcaml_of_verilog.Techlib.Simlib.Op1.P 53 | let sgn p = [ { p with a_signed=0 }; { p with a_signed=1 } ] 54 | let rnd _ = { a_signed = rnd 0 1; a_width = rnd 1 10; y_width = rnd 1 10 } 55 | let params = List.concat [ 56 | sgn { a_signed = 0; a_width = 1; y_width = 1; }; 57 | sgn { a_signed = 0; a_width = 3; y_width = 6; }; 58 | sgn { a_signed = 0; a_width = 6; y_width = 3; }; 59 | List.concat @@ List.map sgn @@ Array.to_list @@ Array.init n_random_params rnd; 60 | ] 61 | end) 62 | 63 | module Op2 = Test(Hardcaml_of_verilog.Techlib.Simlib.Op2)(struct 64 | open Hardcaml_of_verilog.Techlib.Simlib.Op2.P 65 | let sgn p = [ 66 | { p with a_signed=0; b_signed=0 }; 67 | { p with a_signed=0; b_signed=1 }; 68 | { p with a_signed=1; b_signed=0 }; 69 | { p with a_signed=1; b_signed=1 }; 70 | ] 71 | let rnd _ = { a_signed = rnd 0 1; b_signed = rnd 0 1; 72 | a_width = rnd 1 10; b_width = rnd 1 10; 73 | y_width = rnd 1 10 } 74 | let params = List.concat [ 75 | sgn { a_signed = 0; b_signed = 0; a_width = 1; b_width = 1; y_width = 1; }; 76 | sgn { a_signed = 0; b_signed = 0; a_width = 3; b_width = 4; y_width = 6; }; 77 | sgn { a_signed = 0; b_signed = 0; a_width = 3; b_width = 6; y_width = 4; }; 78 | sgn { a_signed = 0; b_signed = 0; a_width = 4; b_width = 3; y_width = 6; }; 79 | sgn { a_signed = 0; b_signed = 0; a_width = 4; b_width = 6; y_width = 3; }; 80 | sgn { a_signed = 0; b_signed = 0; a_width = 6; b_width = 3; y_width = 4; }; 81 | sgn { a_signed = 0; b_signed = 0; a_width = 6; b_width = 4; y_width = 3; }; 82 | List.concat @@ List.map sgn @@ Array.to_list @@ Array.init n_random_params rnd; 83 | ] 84 | end) 85 | 86 | module Fa = Test(Hardcaml_of_verilog.Techlib.Simlib.Fa)(struct 87 | open Hardcaml_of_verilog.Techlib.Simlib.Fa.P 88 | let params = Array.to_list @@ Array.init 9 (fun width -> { width=width+1 }) 89 | end) 90 | 91 | module Lcu = Test(Hardcaml_of_verilog.Techlib.Simlib.Lcu)(struct 92 | open Hardcaml_of_verilog.Techlib.Simlib.Lcu.P 93 | let params = Array.to_list @@ Array.init 9 (fun width -> { width=width+1 }) 94 | end) 95 | 96 | module Slice = Test(Hardcaml_of_verilog.Techlib.Simlib.Slice)(struct 97 | open Hardcaml_of_verilog.Techlib.Simlib.Slice.P 98 | let rnd _ = { offset = rnd 0 10; a_width = rnd 1 10; y_width = rnd 1 10 } 99 | let params = Array.to_list @@ Array.init n_random_params rnd; 100 | end) 101 | 102 | module Concat = Test(Hardcaml_of_verilog.Techlib.Simlib.Concat)(struct 103 | open Hardcaml_of_verilog.Techlib.Simlib.Concat.P 104 | let rnd _ = { a_width = rnd 1 10; b_width = rnd 1 10 } 105 | let params = Array.to_list @@ Array.init n_random_params rnd; 106 | end) 107 | 108 | module Mux = Test(Hardcaml_of_verilog.Techlib.Simlib.Mux)(struct 109 | open Hardcaml_of_verilog.Techlib.Simlib.Mux.P 110 | let params = Array.to_list @@ Array.init 9 (fun width -> { width=width+1 }) 111 | end) 112 | 113 | module Pmux = Test(Hardcaml_of_verilog.Techlib.Simlib.Pmux)(struct 114 | open Hardcaml_of_verilog.Techlib.Simlib.Pmux.P 115 | let rnd _ = { width = rnd 1 10; s_width = rnd 1 10 } 116 | let params = Array.to_list @@ Array.init n_random_params rnd; 117 | end) 118 | 119 | module Lut = Test(Hardcaml_of_verilog.Techlib.Simlib.Lut)(struct 120 | open Hardcaml_of_verilog.Techlib.Simlib.Lut.P 121 | let rnd _ = 122 | let width = rnd 1 4 in 123 | { width; lut = rnd 0 ((1 lsl width)-1) } 124 | let params = Array.to_list @@ Array.init n_random_params rnd; 125 | end) 126 | 127 | let () = Op1.run () 128 | let () = Op2.run () 129 | let () = Fa.run () 130 | let () = Lcu.run () 131 | let () = Slice.run () 132 | let () = Concat.run () 133 | let () = Mux.run () 134 | let () = Pmux.run () 135 | let () = Lut.run () 136 | -------------------------------------------------------------------------------- /test/apps/wrram.ml: -------------------------------------------------------------------------------- 1 | open Hardcaml 2 | open Signal 3 | open Hardcaml_of_verilog 4 | module Cs = Cyclesim 5 | module S = Cyclesim 6 | module Waveterm_waves = Hardcaml_waveterm.Waves 7 | module Waveterm_sim = Hardcaml_waveterm.Sim 8 | module Waveterm_widget = Hardcaml_waveterm_interactive.Widget 9 | 10 | let clock = input "clock" 1 11 | 12 | let testbench () = 13 | let module C = struct 14 | let abits = 4 15 | let dbits = 8 16 | let size = 1 lsl abits 17 | end 18 | in 19 | let module L = Lvt.Make_wren (C) in 20 | let nwr = 2 in 21 | let nrd = 1 in 22 | let layout = [| [| 0; 0; 1; 1; 2; 2; 3; 3 |]; [| 4; 4; 4; 4; 5; 5; 5; 5 |] |] in 23 | let mode = Array.init nrd (fun _ -> `sync_rbw) in 24 | let aname m n = n ^ string_of_int m in 25 | let mk_input m (n, b) = input (aname m n) b in 26 | let wr = Array.init nwr (fun m -> L.Wr.(map ~f:(mk_input m) t)) in 27 | let rd = Array.init nrd (fun m -> L.Rd.(map ~f:(mk_input m) t)) in 28 | let wr' = 29 | Array.init nwr (fun m -> 30 | { Lvt.ram_spec = Reg_spec.create () ~clock 31 | ; reg_spec = Reg_spec.create () ~clock 32 | ; wr = wr.(m) 33 | }) 34 | in 35 | let rd' = 36 | Array.init nrd (fun m -> 37 | { Lvt.reg_spec = Reg_spec.create () ~clock; rd = rd.(m); mode = mode.(m) }) 38 | in 39 | let q = L.memory ~layout ~wr:wr' ~rd:rd' in 40 | let q = Array.init nrd (fun m -> output (aname m "q") q.(m)) in 41 | let circ = Circuit.create_exn ~name:"wrram" (Array.to_list q) in 42 | let sim = Cs.create circ in 43 | let sim, waves = Waveterm_sim.wrap sim in 44 | let rd m = 45 | { L.Rd.ra = S.in_port sim (aname m "ra") 46 | ; re = 47 | (try S.in_port sim (aname m "re") with 48 | | _ -> ref Bits.vdd) 49 | } 50 | in 51 | let wr m = 52 | { L.Wr.wa = S.in_port sim (aname m "wa") 53 | ; we = S.in_port sim (aname m "we") 54 | ; d = S.in_port sim (aname m "d") 55 | } 56 | in 57 | let rd, wr = Array.init nrd rd, Array.init nwr wr in 58 | let open L.Wr in 59 | let open L.Rd in 60 | let cycle () = 61 | S.cycle sim; 62 | Array.iter (fun wr -> wr.we := Bits.of_int ~width:C.dbits 0) wr; 63 | Array.iter (fun rd -> rd.re := Bits.gnd) rd 64 | in 65 | wr.(0).wa := Bits.of_int ~width:C.abits 0; 66 | wr.(0).we := Bits.of_string "00000011"; 67 | wr.(0).d := Bits.of_int ~width:C.dbits 255; 68 | wr.(1).wa := Bits.of_int ~width:C.abits 1; 69 | wr.(1).we := Bits.of_string "11110000"; 70 | wr.(1).d := Bits.of_int ~width:C.dbits 255; 71 | cycle (); 72 | rd.(0).ra := Bits.of_int ~width:C.abits 0; 73 | rd.(0).re := Bits.vdd; 74 | cycle (); 75 | rd.(0).ra := Bits.of_int ~width:C.abits 1; 76 | rd.(0).re := Bits.vdd; 77 | cycle (); 78 | cycle (); 79 | cycle (); 80 | Waveterm_widget.run_and_close Waveterm_waves.{ cfg = Config.default; waves } 81 | ;; 82 | 83 | let () = testbench () 84 | -------------------------------------------------------------------------------- /test/apps/wrram.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/examples/picorv32/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names test) 4 | (libraries hardcaml hardcaml_of_verilog parsexp) 5 | (preprocess 6 | (pps ppx_hardcaml ppx_jane))) 7 | 8 | (rule 9 | (targets picorv32.ml) 10 | (deps picorv32.v %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe 11 | picorv32.sexp) 12 | (action 13 | (bash 14 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize ocaml-module -i picorv32.sexp -o picorv32.ml"))) 15 | -------------------------------------------------------------------------------- /test/examples/picorv32/picorv32.sexp: -------------------------------------------------------------------------------- 1 | (( 2 | top ( 3 | (module_name picorv32) 4 | (path picorv32.v) 5 | (instantiates ()) 6 | (parameters ( 7 | (ENABLE_COUNTERS (Int 1)) 8 | (ENABLE_COUNTERS64 (Int 1)) 9 | (ENABLE_REGS_16_31 (Int 1)) 10 | (ENABLE_REGS_DUALPORT (Int 1)) 11 | (TWO_STAGE_SHIFT (Int 1)) 12 | (BARREL_SHIFTER (Int 0)) 13 | (TWO_CYCLE_COMPARE (Int 0)) 14 | (TWO_CYCLE_ALU (Int 0)) 15 | (COMPRESSED_ISA (Int 0)) 16 | (CATCH_MISALIGN (Int 1)) 17 | (CATCH_ILLINSN (Int 1)) 18 | (ENABLE_PCPI (Int 0)) 19 | (ENABLE_MUL (Int 0)) 20 | (ENABLE_FAST_MUL (Int 0)) 21 | (ENABLE_DIV (Int 0)) 22 | (ENABLE_IRQ (Int 0)) 23 | (ENABLE_IRQ_QREGS (Int 1)) 24 | (ENABLE_IRQ_TIMER (Int 1)) 25 | (ENABLE_TRACE (Int 0)) 26 | (REGS_INIT_ZERO (Int 0)) 27 | (MASKED_IRQ (Int 0x0000_0000)) 28 | (LATCHED_IRQ (Int 0xffff_ffff)) 29 | (PROGADDR_RESET (Int 0x0000_0000)) 30 | (PROGADDR_IRQ (Int 0x0000_0010)) 31 | (STACKADDR (Int 0xffff_ffff)) 32 | (LATCHED_MEM_RDATA (Int 0))))))) 33 | -------------------------------------------------------------------------------- /test/examples/picorv32/test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | let picorv32 () = 4 | let module Inst = 5 | Picorv32.From_verilog 6 | (Picorv32.P) 7 | (struct 8 | let verbose = true 9 | let map_verilog_design = Fn.id 10 | end) 11 | in 12 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 13 | Circ.create_exn ~name:Picorv32.name Inst.create |> Hardcaml.Rtl.print Verilog 14 | ;; 15 | 16 | let () = picorv32 () 17 | -------------------------------------------------------------------------------- /test/examples/picorv32/test.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/examples/simple_adder/carry_save_adder.sexp: -------------------------------------------------------------------------------- 1 | (( 2 | top ( 3 | (module_name carry_save_adder) 4 | (path simple_adder.v) 5 | (instantiates (( 6 | (module_name fa) 7 | (path full_adder.v) 8 | (instantiates (( 9 | (module_name ha) 10 | (path full_adder.v)))))))))) 11 | -------------------------------------------------------------------------------- /test/examples/simple_adder/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names test) 4 | (libraries base core_unix.filename_unix hardcaml hardcaml_of_verilog parsexp 5 | stdio) 6 | (preprocess 7 | (pps ppx_hardcaml ppx_jane)) 8 | (flags :standard -w -60)) 9 | 10 | (rule 11 | (targets simple_adder_8.ml) 12 | (deps simple_adder.v 13 | %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe 14 | simple_adder_8.sexp) 15 | (action 16 | (bash 17 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize ocaml-module -i simple_adder_8.sexp -o simple_adder_8.ml"))) 18 | 19 | (rule 20 | (targets simple_adder_16.ml) 21 | (deps simple_adder.v 22 | %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe 23 | simple_adder_16.sexp) 24 | (action 25 | (bash 26 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize ocaml-module -i simple_adder_16.sexp -o simple_adder_16.ml"))) 27 | 28 | (rule 29 | (targets simple_adder.ml) 30 | (deps simple_adder.v 31 | %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe 32 | simple_adder.sexp) 33 | (action 34 | (bash 35 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize ocaml-module -i simple_adder.sexp -o simple_adder.ml"))) 36 | 37 | (rule 38 | (targets carry_save_adder.ml) 39 | (deps simple_adder.v full_adder.v 40 | %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe 41 | carry_save_adder.sexp carry_save_adder.json) 42 | (action 43 | (bash 44 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize ocaml-module -i carry_save_adder.sexp -o carry_save_adder.ml"))) 45 | 46 | (rule 47 | (targets carry_save_adder.json) 48 | (deps carry_save_adder.sexp simple_adder.v full_adder.v 49 | %{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe) 50 | (action 51 | (bash 52 | "%{workspace_root}/lib/hardcaml/of_verilog/bin/convert.exe synthesize json -i carry_save_adder.sexp -o carry_save_adder.json"))) 53 | -------------------------------------------------------------------------------- /test/examples/simple_adder/full_adder.v: -------------------------------------------------------------------------------- 1 | module ha ( 2 | input a, b, 3 | output c, s 4 | ); 5 | assign s = a ^ b; 6 | assign c = a & b; 7 | endmodule 8 | 9 | module fa ( 10 | input a, b, ci, 11 | output s, co 12 | ); 13 | wire sx; 14 | ha the_ha0 ( .a(a), .b(b), .c(cx), .s(sx) ); 15 | ha the_ha1 ( .a(sx), .b(ci), .c(cy), .s(s) ); 16 | assign co = cx | cy; 17 | endmodule 18 | -------------------------------------------------------------------------------- /test/examples/simple_adder/simple_adder.sexp: -------------------------------------------------------------------------------- 1 | (( 2 | top ( 3 | (module_name simple_adder) 4 | (path simple_adder.v) 5 | (parameters ((N (Int 16))))))) 6 | -------------------------------------------------------------------------------- /test/examples/simple_adder/simple_adder.v: -------------------------------------------------------------------------------- 1 | module simple_adder8 ( 2 | input [7:0] a, b, 3 | output [7:0] c 4 | ); 5 | 6 | assign c = a + b; 7 | 8 | endmodule 9 | 10 | module simple_adder16 ( 11 | input [15:0] a, b, 12 | output [15:0] c 13 | ); 14 | 15 | assign c = a + b; 16 | 17 | endmodule 18 | 19 | module simple_adder #(parameter N=8) ( 20 | input [N-1:0] a, b, 21 | output [N-1:0] c 22 | ); 23 | 24 | assign c = a + b; 25 | 26 | endmodule 27 | 28 | module carry_save_adder ( 29 | input [3:0] a, b, 30 | output [4:0] c 31 | ); 32 | wire [2:0] co; 33 | fa the_fa0 ( .a(a[0]), .b(b[0]), .s(c[0]), .ci(1'b0), .co(co[0]) ); 34 | fa the_fa1 ( .a(a[1]), .b(b[1]), .s(c[1]), .ci(co[0]), .co(co[1]) ); 35 | fa the_fa2 ( .a(a[2]), .b(b[2]), .s(c[2]), .ci(co[1]), .co(co[2]) ); 36 | fa the_fa3 ( .a(a[3]), .b(b[3]), .s(c[3]), .ci(co[2]), .co(c[4]) ); 37 | endmodule 38 | -------------------------------------------------------------------------------- /test/examples/simple_adder/simple_adder_16.sexp: -------------------------------------------------------------------------------- 1 | (( 2 | top ( 3 | (module_name simple_adder16) 4 | (path simple_adder.v) 5 | (instantiates ()) 6 | (parameters ())))) 7 | -------------------------------------------------------------------------------- /test/examples/simple_adder/simple_adder_8.sexp: -------------------------------------------------------------------------------- 1 | (( 2 | top ( 3 | (module_name simple_adder8) 4 | (path simple_adder.v)))) 5 | -------------------------------------------------------------------------------- /test/examples/simple_adder/test.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Default = struct 4 | let verbose = false 5 | let map_verilog_design = Fn.id 6 | end 7 | 8 | let simple_adder_8 () = 9 | let module Inst = Simple_adder_8.From_verilog (struct end) (Default) in 10 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 11 | Circ.create_exn ~name:Simple_adder_8.name Inst.create |> Hardcaml.Rtl.print Verilog 12 | ;; 13 | 14 | let simple_adder_16 () = 15 | let module Inst = Simple_adder_16.From_verilog (struct end) (Default) in 16 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 17 | Circ.create_exn ~name:Simple_adder_16.name Inst.create |> Hardcaml.Rtl.print Verilog 18 | ;; 19 | 20 | let simple_adder () = 21 | let module Inst = 22 | Simple_adder.From_verilog 23 | (struct 24 | let n = 23 25 | end) 26 | (Default) 27 | in 28 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 29 | Circ.create_exn ~name:Simple_adder.name Inst.create |> Hardcaml.Rtl.print Verilog 30 | ;; 31 | 32 | let carry_save_adder () = 33 | let module Inst = 34 | Carry_save_adder.From_verilog (struct end) 35 | (struct 36 | let verbose = false 37 | 38 | (* Example custom read mode. Copies the file to tmp, and modifies the 39 | verilog_design. Note we must take care to share files if there are multiple 40 | verilog modules in the same file. *) 41 | let map_verilog_design v = 42 | let seen = Hashtbl.create (module String) in 43 | Hardcaml_of_verilog.Verilog_design.map_paths v ~f:(fun path -> 44 | match Hashtbl.find seen path with 45 | | None -> 46 | let tmp_file = Filename_unix.temp_file "tmp" ".v" in 47 | Stdio.Out_channel.write_all tmp_file ~data:(Stdio.In_channel.read_all path); 48 | Hashtbl.set seen ~key:path ~data:tmp_file; 49 | tmp_file 50 | | Some tmp_file -> tmp_file) 51 | ;; 52 | end) 53 | in 54 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 55 | Circ.create_exn ~name:Carry_save_adder.name Inst.create |> Hardcaml.Rtl.print Verilog 56 | ;; 57 | 58 | (* Read data from a pregenerated json file (see jbuild). *) 59 | let carry_save_adder_json () = 60 | let module Inst = 61 | Carry_save_adder.From_json (struct 62 | let json = Stdio.In_channel.read_all "carry_save_adder.json" 63 | end) 64 | in 65 | let module Circ = Hardcaml.Circuit.With_interface (Inst.I) (Inst.O) in 66 | Circ.create_exn ~name:Carry_save_adder.name Inst.create |> Hardcaml.Rtl.print Verilog 67 | ;; 68 | 69 | let () = simple_adder_8 () 70 | let () = simple_adder_16 () 71 | let () = simple_adder () 72 | let () = carry_save_adder () 73 | let () = carry_save_adder () 74 | let () = carry_save_adder_json () 75 | -------------------------------------------------------------------------------- /test/examples/simple_adder/test.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name hardcaml_of_verilog_test) 3 | (libraries core core_unix core_unix.filename_unix hardcaml_of_verilog 4 | expect_test_helpers_core hardcaml stdio) 5 | (preprocess 6 | (pps ppx_jane ppx_hardcaml))) 7 | -------------------------------------------------------------------------------- /test/lib/hardcaml_of_verilog_test.ml: -------------------------------------------------------------------------------- 1 | (*_ Nothing to export. *) 2 | -------------------------------------------------------------------------------- /test/lib/test_circuit.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Hardcaml_of_verilog 3 | 4 | let of_verilog ?verbose ?(netlist = false) ?passes verilog = 5 | let verilog_file = Stdlib.Filename.temp_file "test" ".v" in 6 | Stdio.Out_channel.write_all verilog_file ~data:verilog; 7 | let verilog_design = 8 | Verilog_design.create 9 | ~top:(Verilog_design.Module.create ~module_name:"top" ~path:verilog_file ()) 10 | () 11 | in 12 | let to_netlist () = Netlist.create ?verbose ?passes verilog_design in 13 | let to_circuit () = 14 | let%bind.Or_error netlist = to_netlist () in 15 | let%bind.Or_error t = 16 | Verilog_circuit.create netlist ~top_name:(Verilog_design.top_name verilog_design) 17 | in 18 | let%bind.Or_error circuit = Verilog_circuit.to_hardcaml_circuit t in 19 | Hardcaml.Rtl.print Verilog circuit; 20 | Ok () 21 | in 22 | if netlist then print_s [%message (to_netlist () : Netlist.t Or_error.t)]; 23 | print_s [%message (to_circuit () : unit Or_error.t)] 24 | ;; 25 | 26 | let%expect_test "no module output driver" = 27 | of_verilog 28 | ~netlist:true 29 | {| 30 | module top (input a, output b); endmodule 31 | |}; 32 | [%expect 33 | {| 34 | ("to_netlist ()" (Ok (top))) 35 | ("to_circuit ()" (Error ("Failed to find net in bus map" (i 3)))) 36 | |}] 37 | ;; 38 | 39 | let%expect_test "simple assignment" = 40 | of_verilog 41 | {| 42 | module top (input a, output b); assign b = a; endmodule 43 | |}; 44 | [%expect 45 | {| 46 | module top ( 47 | a, 48 | b 49 | ); 50 | 51 | input a; 52 | output b; 53 | 54 | wire a_0; 55 | wire b_0; 56 | assign a_0 = a; 57 | assign b_0 = a_0; 58 | assign b = a_0; 59 | 60 | endmodule 61 | ("to_circuit ()" (Ok ())) 62 | |}] 63 | ;; 64 | 65 | let%expect_test "simple xor of inputs" = 66 | of_verilog 67 | {| 68 | module top (input a, output b); 69 | wire x; 70 | assign x = a; 71 | assign b = x ^ x; 72 | endmodule 73 | |}; 74 | [%expect 75 | {| 76 | module top ( 77 | a, 78 | b 79 | ); 80 | 81 | input a; 82 | output b; 83 | 84 | wire a_0; 85 | wire x; 86 | wire _5; 87 | wire b_0; 88 | assign a_0 = a; 89 | assign _5 = a_0 ^ a_0; 90 | assign b_0 = _5; 91 | assign x = a_0; 92 | assign b = b_0; 93 | 94 | endmodule 95 | ("to_circuit ()" (Ok ())) 96 | |}] 97 | ;; 98 | 99 | let%expect_test "unused input bits" = 100 | of_verilog 101 | {| 102 | module top (input [1:0] a, output b); 103 | wire x; 104 | assign x = a[0]; 105 | assign b = x + 1; 106 | endmodule 107 | |}; 108 | [%expect 109 | {| 110 | module top ( 111 | a, 112 | b 113 | ); 114 | 115 | input [1:0] a; 116 | output b; 117 | 118 | wire [31:0] _8; 119 | wire [1:0] a_0; 120 | wire x; 121 | wire [30:0] _5; 122 | wire [31:0] _7; 123 | wire [31:0] _9; 124 | wire [31:0] _3; 125 | wire b_0; 126 | assign _8 = 32'b00000000000000000000000000000001; 127 | assign a_0 = a; 128 | assign x = a_0[0:0]; 129 | assign _5 = 31'b0000000000000000000000000000000; 130 | assign _7 = { _5, 131 | x }; 132 | assign _9 = _7 + _8; 133 | assign _3 = _9; 134 | assign b_0 = _3[0:0]; 135 | assign b = b_0; 136 | 137 | endmodule 138 | ("to_circuit ()" (Ok ())) 139 | |}] 140 | ;; 141 | 142 | let%expect_test "instantiate module" = 143 | let verilog = 144 | {| 145 | module foo (input a, b, output c); assign c = a & b; endmodule 146 | module top (input a, b, output c); 147 | foo the_foo (.a(a), .b(b), .c(c)); 148 | endmodule 149 | |} 150 | in 151 | (* flattened by yosys *) 152 | of_verilog verilog; 153 | [%expect 154 | {| 155 | module top ( 156 | b, 157 | a, 158 | c 159 | ); 160 | 161 | input b; 162 | input a; 163 | output c; 164 | 165 | wire b_0; 166 | wire the_foo_b; 167 | wire a_0; 168 | wire the_foo_a; 169 | wire _7; 170 | wire c_0; 171 | wire the_foo_c; 172 | assign b_0 = b; 173 | assign a_0 = a; 174 | assign _7 = a_0 & b_0; 175 | assign c_0 = _7; 176 | assign the_foo_b = b_0; 177 | assign the_foo_a = a_0; 178 | assign the_foo_c = c_0; 179 | assign c = c_0; 180 | 181 | endmodule 182 | ("to_circuit ()" (Ok ())) 183 | |}]; 184 | (* keep hierarchy *) 185 | of_verilog ~passes:[ Proc; Opt { mux_undef = false }; Clean ] verilog; 186 | [%expect 187 | {| 188 | module top ( 189 | a, 190 | b, 191 | c 192 | ); 193 | 194 | input a; 195 | input b; 196 | output c; 197 | 198 | wire a_0; 199 | wire b_0; 200 | wire _8; 201 | wire _5; 202 | wire c_0; 203 | assign a_0 = a; 204 | assign b_0 = b; 205 | foo 206 | the_foo 207 | ( .b(b_0), 208 | .a(a_0), 209 | .c(_8) ); 210 | assign _5 = _8; 211 | assign c_0 = _5; 212 | assign c = c_0; 213 | 214 | endmodule 215 | ("to_circuit ()" (Ok ())) 216 | |}] 217 | ;; 218 | -------------------------------------------------------------------------------- /test/lib/test_circuit.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/lib/test_circuit_to_json.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Hardcaml 3 | open Hardcaml_of_verilog 4 | open Signal 5 | 6 | module I = struct 7 | type 'a t = 8 | { clock : 'a 9 | ; clear : 'a 10 | ; a : 'a [@bits 1] 11 | ; b : 'a [@bits 1] 12 | } 13 | [@@deriving hardcaml] 14 | end 15 | 16 | module O = struct 17 | type 'a t = { y : 'a [@bits 1] } [@@deriving hardcaml] 18 | end 19 | 20 | let create (i : _ I.t) = 21 | let spec = Reg_spec.create ~clock:i.clock ~clear:i.clear () in 22 | { O.y = reg spec ~enable:vdd (i.a +: i.b) } 23 | ;; 24 | 25 | let%expect_test "simple adder to json" = 26 | let module Circuit = Hardcaml.Circuit.With_interface (I) (O) in 27 | let circuit = Circuit.create_exn ~name:"adder" create in 28 | let json = 29 | Circuit_to_json.convert ~debug:true circuit |> Expert.Yosys_netlist.to_string_hum 30 | in 31 | Out_channel.print_string json; 32 | [%expect 33 | {| 34 | (!ignore_set (11)) 35 | (!driver_map ((2 1) (4 3) (6 5) (8 7) (9 12))) 36 | (!select_map ()) 37 | Wire[id:9 bits:1 names:y deps:12] -> 12 38 | Reg[id:12 bits:1 names: deps:10,4,2,11] 39 | Op[id:10 bits:1 names: deps:8,6] = add 40 | Wire[id:8 bits:1 names: deps:7] -> 7 41 | Wire[id:7 bits:1 names:a deps:] -> () 42 | Wire[id:6 bits:1 names: deps:5] -> 5 43 | Wire[id:5 bits:1 names:b deps:] -> () 44 | Wire[id:4 bits:1 names: deps:3] -> 3 45 | Wire[id:3 bits:1 names:clock deps:] -> () 46 | Wire[id:2 bits:1 names: deps:1] -> 1 47 | Wire[id:1 bits:1 names:clear deps:] -> () 48 | Const[id:11 bits:1 names: deps:] = 0 49 | { 50 | "creator": "hardcaml", 51 | "modules": { 52 | "adder": { 53 | "ports": { 54 | "clear": { 55 | "direction": "input", 56 | "bits": [ 57 | 1 58 | ] 59 | }, 60 | "clock": { 61 | "direction": "input", 62 | "bits": [ 63 | 3 64 | ] 65 | }, 66 | "b": { 67 | "direction": "input", 68 | "bits": [ 69 | 5 70 | ] 71 | }, 72 | "a": { 73 | "direction": "input", 74 | "bits": [ 75 | 7 76 | ] 77 | }, 78 | "y": { 79 | "direction": "output", 80 | "bits": [ 81 | 12 82 | ] 83 | } 84 | }, 85 | "cells": { 86 | "$gate10": { 87 | "hide_name": 0, 88 | "type": "$add", 89 | "parameters": {}, 90 | "port_directions": { 91 | "A": "input", 92 | "B": "input", 93 | "Y": "output" 94 | }, 95 | "connections": { 96 | "A": [ 97 | 7 98 | ], 99 | "B": [ 100 | 5 101 | ], 102 | "Y": [ 103 | 10 104 | ] 105 | } 106 | }, 107 | "$procdff$12": { 108 | "hide_name": 0, 109 | "type": "$our_dff", 110 | "parameters": {}, 111 | "port_directions": { 112 | "CLK": "input", 113 | "CE": "input", 114 | "CLR": "input", 115 | "RST": "input", 116 | "D": "input", 117 | "Q": "output" 118 | }, 119 | "connections": { 120 | "D": [ 121 | 10 122 | ], 123 | "CLR": [ 124 | 1 125 | ], 126 | "RST": [ 127 | 0 128 | ], 129 | "CLK": [ 130 | 3 131 | ], 132 | "CE": [ 133 | 0 134 | ], 135 | "Q": [ 136 | 12 137 | ] 138 | } 139 | } 140 | }, 141 | "netnames": {} 142 | } 143 | } 144 | } 145 | |}] 146 | ;; 147 | -------------------------------------------------------------------------------- /test/lib/test_circuit_to_json.mli: -------------------------------------------------------------------------------- 1 | (** An example of a simple adder in Hardcaml. *) 2 | open Hardcaml 3 | 4 | module I : sig 5 | type 'a t = 6 | { clock : 'a 7 | ; clear : 'a 8 | ; a : 'a 9 | ; b : 'a 10 | } 11 | [@@deriving hardcaml] 12 | end 13 | 14 | module O : sig 15 | type 'a t = { y : 'a } [@@deriving hardcaml] 16 | end 17 | 18 | val create : Signal.t I.t -> Signal.t O.t 19 | -------------------------------------------------------------------------------- /test/lib/test_interface.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open Hardcaml_of_verilog 3 | open Expect_test_helpers_core 4 | 5 | module I = struct 6 | type 'a t = { a : 'a } [@@deriving hardcaml] 7 | end 8 | 9 | module O = struct 10 | type 'a t = { b : 'a } [@@deriving hardcaml] 11 | end 12 | 13 | module Conv = With_interface.Make (I) (O) 14 | 15 | let verilog = {| module testme (input [2:0] a, output b); assign b = !a; endmodule |} 16 | 17 | let%expect_test "load simple design" = 18 | let tmp = Filename_unix.temp_file "hardcaml_of_verilog_interface_" ".v" in 19 | Out_channel.write_all tmp ~data:verilog; 20 | let f = 21 | Conv.create 22 | Verilog_design.(create ~top:(Module.create ~module_name:"testme" ~path:tmp ()) ()) 23 | in 24 | Core_unix.unlink tmp; 25 | require_does_not_raise (fun () -> 26 | let f = Or_error.ok_exn f in 27 | let o = f { a = Hardcaml.Signal.wire 3 } |> Or_error.ok_exn in 28 | print_s [%message (o : _ O.t)]); 29 | [%expect {| (o ((b _))) |}] 30 | ;; 31 | -------------------------------------------------------------------------------- /test/lib/test_interface.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/lib/test_json.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Hardcaml_of_verilog 3 | 4 | let header_json = 5 | {| 6 | { "creator" : "yosys", 7 | "modules" : {} 8 | } 9 | |} 10 | ;; 11 | 12 | let basic_json = 13 | {| 14 | { "creator" : "yosys", 15 | "modules" : 16 | { "foo": 17 | { "ports": { "clock": { "direction": "input", "bits": [ 2, 3, 4 ] }, 18 | "q": { "direction": "output", "bits": [ "1", "0", 0, 1 ]} 19 | }, 20 | "cells": { "mymodule": { "hide_name": 1, 21 | "type": "foo", 22 | "parameters": {}, 23 | "port_directions": { "A": "input", "B": "output" }, 24 | "connections": { "A": [ 1, "1", 12 ], "B": [ ] } 25 | } 26 | }, 27 | "netnames": 28 | { "fudge": 29 | { "hide_name": 0, 30 | "bits": [ 200 ], 31 | "attributes": { "src": "/home/andyman/foo.v:1001" } 32 | } 33 | } 34 | }, 35 | "bar": 36 | { "ports": { }, 37 | "cells": { }, 38 | "netnames": { } 39 | } 40 | } 41 | } 42 | |} 43 | ;; 44 | 45 | let parse json = Expert.Yosys_netlist.of_string json 46 | 47 | let%expect_test "basic header" = 48 | let t = parse header_json in 49 | print_s [%message (t : Expert.Yosys_netlist.t Or_error.t)]; 50 | [%expect {| (t (Ok ((creator yosys) (modules ())))) |}] 51 | ;; 52 | 53 | let%expect_test "basic yosys json" = 54 | let t = parse basic_json in 55 | print_s [%message (t : Expert.Yosys_netlist.t Or_error.t)]; 56 | [%expect 57 | {| 58 | (t 59 | (Ok 60 | ((creator yosys) 61 | (modules 62 | (((name foo) 63 | (value 64 | ((ports 65 | (((name clock) 66 | (value ((direction Input) (bits ((Index 2) (Index 3) (Index 4)))))) 67 | ((name q) 68 | (value ((direction Output) (bits (Vdd Gnd (Index 0) (Index 1)))))))) 69 | (cells 70 | (((name mymodule) 71 | (value 72 | ((hide_name 1) (module_name foo) (parameters ()) 73 | (port_directions 74 | (((name A) (value Input)) ((name B) (value Output)))) 75 | (connections 76 | (((name A) (value ((Index 1) Vdd (Index 12)))) 77 | ((name B) (value ()))))))))) 78 | (netnames 79 | (((name fudge) (value ((hide_name 0) (bits ((Index 200))))))))))) 80 | ((name bar) (value ((ports ()) (cells ()) (netnames ()))))))))) 81 | |}] 82 | ;; 83 | -------------------------------------------------------------------------------- /test/lib/test_json.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/lib/test_synthesize.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | let top = Test_verilog_design.top 4 | 5 | let%expect_test "yosys script" = 6 | let script = 7 | Hardcaml_of_verilog.Expert.Synthesize.yosys_script top ~json_file:"out.json" 8 | in 9 | Out_channel.print_string script; 10 | [%expect 11 | {| 12 | read_verilog -defer -lib vlog/bar.v 13 | read_verilog -defer vlog/brumble.v 14 | read_verilog -defer vlog/fudge.v 15 | read_verilog -defer vlog/foo.v 16 | chparam -set A 1 -set B "popcorn" foo 17 | hierarchy -top foo 18 | proc 19 | flatten 20 | memory -nomap 21 | opt 22 | clean 23 | opt -mux_undef 24 | clean 25 | write_json out.json 26 | |}] 27 | ;; 28 | 29 | let%expect_test "custom passes" = 30 | let script = 31 | Hardcaml_of_verilog.Expert.Synthesize.yosys_script 32 | ~passes:[ Clean ] 33 | top 34 | ~json_file:"out.json" 35 | in 36 | Out_channel.print_string script; 37 | [%expect 38 | {| 39 | read_verilog -defer -lib vlog/bar.v 40 | read_verilog -defer vlog/brumble.v 41 | read_verilog -defer vlog/fudge.v 42 | read_verilog -defer vlog/foo.v 43 | chparam -set A 1 -set B "popcorn" foo 44 | hierarchy -top foo 45 | clean 46 | write_json out.json 47 | |}] 48 | ;; 49 | -------------------------------------------------------------------------------- /test/lib/test_synthesize.mli: -------------------------------------------------------------------------------- 1 | (*_ This signature is deliberately empty. *) 2 | -------------------------------------------------------------------------------- /test/lib/test_verilog_design.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | module V = Hardcaml_of_verilog.Verilog_design 3 | module M = V.Module 4 | 5 | let top = 6 | V.create 7 | ~top: 8 | (M.create 9 | ~module_name:"foo" 10 | ~path:"vlog/foo.v" 11 | ~parameters: 12 | [ V.Parameter.create ~name:"A" ~value:(Int 1) 13 | ; V.Parameter.create ~name:"B" ~value:(String "popcorn") 14 | ] 15 | ~instantiates: 16 | [ M.create ~module_name:"bar" ~path:"vlog/bar.v" ~blackbox:true () 17 | ; M.create 18 | ~module_name:"fudge" 19 | ~path:"vlog/fudge.v" 20 | ~instantiates:[ M.create ~module_name:"brumble" ~path:"vlog/brumble.v" () ] 21 | () 22 | ] 23 | ()) 24 | () 25 | ;; 26 | 27 | let%expect_test "map/iter" = 28 | let modules = V.top top in 29 | M.iter modules ~f:(fun m -> Out_channel.print_endline (M.module_name m)); 30 | [%expect 31 | {| 32 | bar 33 | brumble 34 | fudge 35 | foo 36 | |}]; 37 | let modules = 38 | M.map modules ~f:(fun m -> 39 | M.create 40 | ~module_name:(M.module_name m |> String.uppercase) 41 | ~path:(M.path m) 42 | ~instantiates:(M.instantiates m) 43 | ()) 44 | in 45 | print_s [%message (modules : M.t)]; 46 | [%expect 47 | {| 48 | (modules 49 | ((module_name FOO) (path vlog/foo.v) 50 | (instantiates 51 | (((module_name BAR) (path vlog/bar.v) (instantiates ()) (parameters ()) 52 | (blackbox false)) 53 | ((module_name FUDGE) (path vlog/fudge.v) 54 | (instantiates 55 | (((module_name BRUMBLE) (path vlog/brumble.v) (instantiates ()) 56 | (parameters ()) (blackbox false)))) 57 | (parameters ()) (blackbox false)))) 58 | (parameters ()) (blackbox false))) 59 | |}]; 60 | let modules = M.flat_map modules ~f:(fun m -> M.module_name m, M.path m) in 61 | print_s [%message (modules : (string * string) list)]; 62 | [%expect 63 | {| 64 | (modules 65 | ((FOO vlog/foo.v) (BAR vlog/bar.v) (FUDGE vlog/fudge.v) 66 | (BRUMBLE vlog/brumble.v))) 67 | |}] 68 | ;; 69 | -------------------------------------------------------------------------------- /test/lib/test_verilog_design.mli: -------------------------------------------------------------------------------- 1 | val top : Hardcaml_of_verilog.Verilog_design.t 2 | -------------------------------------------------------------------------------- /test/verilog/adff.v: -------------------------------------------------------------------------------- 1 | module adff_test ( 2 | input clk, reset_n, 3 | input [100:0] d, 4 | output reg [100:0] q 5 | ); 6 | 7 | always @(posedge clk, negedge reset_n) 8 | if (!reset_n) q <= 1; 9 | else q <= d; 10 | 11 | endmodule 12 | -------------------------------------------------------------------------------- /test/verilog/bbox.v: -------------------------------------------------------------------------------- 1 | // See what happens with black boxes 2 | (* blackbox *) 3 | module bbox #( 4 | parameter x=1 5 | ) ( 6 | input a, b, 7 | output [x:0] c 8 | ); 9 | 10 | endmodule 11 | 12 | module top ( 13 | input a, b, 14 | output [1:0] c, 15 | output [2:0] d, 16 | output reg e 17 | ); 18 | 19 | bbox #(.x(1)) the_bbox1 (.a(a), .b(b), .c(c)); 20 | bbox #(.x(2)) the_bbox2 (.a(a), .b(b), .c(d)); 21 | 22 | // infer a dlatch 23 | 24 | always @* 25 | if (a) e = b; 26 | 27 | endmodule 28 | -------------------------------------------------------------------------------- /test/verilog/counter.v: -------------------------------------------------------------------------------- 1 | // A simple test design which we can simulate through the yosys->hardcaml flow 2 | 3 | module counter ( 4 | input clk, rst, clr, en, 5 | output reg [7:0] q 6 | ); 7 | reg [7:0] c; 8 | 9 | always @(posedge clk, posedge rst) begin 10 | if (rst) c <= 0; 11 | else if (clr) c <= 0; 12 | else if (en) c <= c + 1; 13 | end 14 | 15 | assign q = c; 16 | 17 | endmodule 18 | 19 | -------------------------------------------------------------------------------- /test/verilog/mem.v: -------------------------------------------------------------------------------- 1 | // async 2 | module async_1rd_1wr ( 3 | input clk, 4 | input [7:0] a, 5 | input we, 6 | input [15:0] d, 7 | output [15:0] q 8 | ); 9 | reg [15:0] mem[0:255]; 10 | always @(posedge clk) if (we) mem[a] <= d; 11 | assign q = mem[a]; 12 | endmodule 13 | 14 | // sync 15 | module sync_1rd_1wr ( 16 | input clk, 17 | input [7:0] a, 18 | input we, 19 | input [15:0] d, 20 | output reg [15:0] q 21 | ); 22 | reg [15:0] mem[0:255]; 23 | always @(posedge clk) if (we) mem[a] <= d; 24 | always @(posedge clk) q <= mem[a]; 25 | endmodule 26 | 27 | // sync (transparent) 28 | module sync_1rd_1wr_t ( 29 | input clk, 30 | input [7:0] a, 31 | input we, 32 | input [15:0] d, 33 | output [15:0] q 34 | ); 35 | reg [15:0] mem[0:255]; 36 | reg [7:0] ra; 37 | always @(posedge clk) if (we) mem[a] <= d; 38 | always @(posedge clk) ra <= a; 39 | assign q = mem[ra]; 40 | endmodule 41 | 42 | // sync with byte enables 43 | module sync_1rd_1wr_byteen ( 44 | input clk, 45 | input [7:0] a, 46 | input [1:0] we, 47 | input [15:0] d, 48 | output reg [15:0] q 49 | ); 50 | reg [15:0] mem[0:255]; 51 | always @(posedge clk) begin 52 | if (we[0]) mem[a][7:0] <= d[7:0]; 53 | if (we[1]) mem[a][15:8] <= d[15:8]; 54 | end 55 | always @(posedge clk) q <= mem[a]; 56 | endmodule 57 | 58 | // sync with bit enables 59 | module sync_1rd_1wr_biten ( 60 | input clk, 61 | input [7:0] a, 62 | input [15:0] we, 63 | input [15:0] d, 64 | output reg [15:0] q 65 | ); 66 | reg [15:0] mem[0:255]; 67 | integer i; 68 | always @(posedge clk) begin 69 | for (i=0; i<16; i=i+1) begin 70 | if (we[i]) mem[a][i] <= d[i]; 71 | end 72 | end 73 | always @(posedge clk) q <= mem[a]; 74 | endmodule 75 | 76 | // sync 2rd 2wr 77 | module sync_2rd_2wr ( 78 | input clk, 79 | input [7:0] ra0, 80 | input [7:0] ra1, 81 | input [7:0] wa0, 82 | input [7:0] wa1, 83 | input [1:0] we, 84 | input [1:0] re, 85 | input [15:0] d0, 86 | input [15:0] d1, 87 | output reg [15:0] q0, 88 | output reg [15:0] q1 89 | ); 90 | reg [15:0] mem[0:255]; 91 | integer i; 92 | always @(posedge clk) begin 93 | if (we0) mem[wa0] <= d0; 94 | if (we1) mem[wa1] <= d1; 95 | end 96 | always @(posedge clk) if (re[0]) q0 <= mem[ra0]; 97 | always @(posedge clk) if (re[1]) q1 <= mem[ra1]; 98 | endmodule 99 | 100 | --------------------------------------------------------------------------------