summaryrefslogtreecommitdiff
path: root/cpu
diff options
context:
space:
mode:
Diffstat (limited to 'cpu')
-rw-r--r--cpu/alu.ml108
-rw-r--r--cpu/cpu.ml2
-rw-r--r--cpu/netlist_gen.ml70
-rw-r--r--cpu/netlist_gen.mli2
-rw-r--r--cpu/netlist_printer.ml82
5 files changed, 194 insertions, 70 deletions
diff --git a/cpu/alu.ml b/cpu/alu.ml
index f437bd3..9f83369 100644
--- a/cpu/alu.ml
+++ b/cpu/alu.ml
@@ -53,15 +53,117 @@ let nadder n a b =
let a, b = nadder_with_carry n a b (const "0") in
b ^. a
+let neg n a = nadder n (not a) (one n)
+
let rec nsubber n a b =
- zeroes n (* TODO *)
+ let r, c = nadder_with_carry n a (not b) (const "1") in
+ c ^. r
+
+
+
+
+(* Some operations on Redundant Binary Representation
+ Each binary digit is encoded on 2 bits
+
+ A n-digits number in RBR is written
+ [a_0, a'_0, a_1, a'_1, ..., a_(n-1), a'_(n-1)]
+
+*)
+
+(* [a] and [b] are encoded on 2n bits
+ [c_in] and [c_out] on 2 bits *)
+
+let rec rbr_nadder_with_carry n a b c_in =
+
+ if n = 0 then (zeroes 0), c_in else
+
+ let fa1s, fa1r = fulladder (a ** 1) (b ** 0) (b ** 1) in
+ let fa2s, fa2r = fulladder (c_in ** 1) (a ** 0) fa1s in
+
+ let rec_s, rec_c =
+ rbr_nadder_with_carry (n - 1)
+ (a % (2, 2*n - 1))
+ (b % (2, 2*n - 1))
+ (fa1r ++ fa2r)
+
+ in (c_in ** 0) ++ fa2s ++ rec_s, rec_c
+
+
+let rbr_nadder n a b =
+ let s, c = rbr_nadder_with_carry n a b (zeroes 2) in
+ c ^. s
+
+
+let bin_of_rbr n a c =
+
+ (* Split even and odd bits *)
+ let rec split_bits n a =
+ if n = 0 then (zeroes 0, zeroes 0)
+ else
+ let even, odd = split_bits (n-1) (a % (2, 2*n - 1)) in
+ (a ** 0) ++ even, (a ** 1) ++ odd
+
+ in
+ let a_even, a_odd = split_bits n a in
+
+ nadder n a_even a_odd
+
+
+
+(* TODO : move to utils module *)
+let rec range a b = if a > b then [] else a :: (range (a+1) b)
+
+(* Sépare en deux listes de même taille une liste de taille paire *)
+let rec split_list = function
+ | [] -> [], []
+ | [_] -> assert false
+ | x::y::tl -> let a, b = split_list tl in x::a, y::b
+
+(* n must be a power of two *)
+(*
+let nmul n a b =
+
+ let summands = List.map (fun i ->
+ mux (b ** i)
+ (zeroes (2*n))
+ ((zeroes i) ++ a ++ (zeroes (n - i)))
+
+ ) (range 0 (n-1)) in
+
+
+ let rec sum_list = function
+ | [x] -> x
+ | l ->
+ let s1, s2 = split_list l in
+ nadder (2*n) (sum_list s1) (sum_list s2)
+
+ in let r = List.fold_left (nadder (2*n)) (List.hd summands) (List.tl summands) in
+
+
+ (*in
+ let r = sum_list summands in*)
+ (r % (0, n-1)), (r % (n, 2*n - 1))
+ *)
+
+let nmul n a b =
+ let nn = 2*n in
+ let result = ref (zeroes (nn)) in
+ for i = 0 to n-1 do
+ result := mux (b ** i) !result (nadder nn !result ((zeroes i) ++ a ++ (zeroes (n-i))))
+ done;
+ let r = !result in
+ r % (0, n-1), r % (n, nn-1)
+
+
+
-let rec nmul n a b =
- zeroes n, zeroes n (* TODO : retuns lo and hi part of 32-bit answer *)
let rec ndiv n a b =
zeroes n, zeroes n (* TODO : returns quotient and remainder *)
+
+
+
let rec nmulu n a b =
zeroes n, zeroes n (* TODO : same as nmul but unsigned *)
diff --git a/cpu/cpu.ml b/cpu/cpu.ml
index 3f9dd74..c5643ec 100644
--- a/cpu/cpu.ml
+++ b/cpu/cpu.ml
@@ -313,5 +313,5 @@ let p =
"ser_in_busy", 1, ser_in_busy;
]
-let () = Netlist_gen.print stdout p
+let () = Netlist_printer.print_program stdout p
diff --git a/cpu/netlist_gen.ml b/cpu/netlist_gen.ml
index 016c595..956de91 100644
--- a/cpu/netlist_gen.ml
+++ b/cpu/netlist_gen.ml
@@ -59,7 +59,12 @@ let ( ++ ) v1 v2 =
let x1, p = v1 p in
let x2, p = v2 p in
let sz1, sz2 = get_size p x1, get_size p x2 in
- (Avar i), add p i (Econcat (x1, x2)) (sz1 + sz2)
+ if sz1 = 0 then
+ (x2), p
+ else if sz2 = 0 then
+ (x1), p
+ else
+ (Avar i), add p i (Econcat (x1, x2)) (sz1 + sz2)
let ( ^| ) v1 v2 =
let i = id "" in
@@ -198,66 +203,3 @@ let program entries outputs =
p_outputs = List.rev outputs }
-(* Netlist printer *)
-
-let init_string n f =
- let s = String.make n 'a' in
- for i = 0 to n - 1 do
- s.[i] <- f i
- done;
- s
-
-(* value to string *)
-let vts bits =
- init_string (Array.length bits) (fun i ->
- if bits.(i) then '1' else '0')
-
-(* argument to string *)
-let ats = function
- | Avar id -> id
- | Aconst n -> vts n
-
-let s_op = function
- | Or -> "OR"
- | Xor -> "XOR"
- | And -> "AND"
- | Nand -> "NAND"
-
-let print oc p =
- let print_eq oc (s,e) =
- let s_e =
- match e with
- | Earg a -> ats a
- | Ereg s -> "REG " ^ s
- | Enot a -> "NOT " ^ (ats a)
- | Ebinop (b,a1,a2) -> (s_op b) ^ " " ^ (ats a1) ^ " " ^ (ats a2)
- | Emux (a1,a2,a3) ->
- "MUX " ^ (ats a1) ^ " " ^ (ats a2) ^ " " ^ (ats a3)
- | Erom (n1,n2,a3) ->
- "ROM " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^
- " " ^ (ats a3)
- | Eram (n1,n2,a3,a4,a5,a6) ->
- "RAM " ^ (string_of_int n1) ^ " " ^ (string_of_int n2) ^
- " " ^ (ats a3) ^ " " ^ (ats a4) ^ " " ^ (ats a5) ^
- " " ^ (ats a6)
- | Econcat (a1,a2) -> "CONCAT " ^ (ats a1) ^ " " ^ (ats a2)
- | Eslice (n1,n2,a3) -> "SLICE " ^ (string_of_int n1) ^ " " ^
- (string_of_int n2) ^ " " ^ (ats a3)
- | Eselect (n,a) -> "SELECT " ^ (string_of_int n) ^ " " ^ (ats a) in
- Printf.fprintf oc "%s = %s\n" s s_e in
- Printf.fprintf oc "INPUT ";
- if p.p_inputs <> [] then
- (Printf.fprintf oc "%s" (List.hd p.p_inputs); List.iter
- (Printf.fprintf oc ", %s") (List.tl p.p_inputs));
- Printf.fprintf oc "\nOUTPUT ";
- if p.p_outputs <> [] then
- (Printf.fprintf oc "%s" (List.hd p.p_outputs); List.iter
- (Printf.fprintf oc ", %s") (List.tl p.p_outputs));
- Printf.fprintf oc "\nVAR ";
- let stts s t = if t = 1 then s else s ^ " : " ^ (string_of_int t) in
- Pervasives.ignore (Env.fold (fun s t b ->
- if b then Printf.fprintf oc "%s" (stts s t)
- else Printf.fprintf oc ", %s" (stts s t);
- false) p.p_vars true);
- Printf.fprintf oc "\nIN\n";
- List.iter (print_eq oc) p.p_eqs
diff --git a/cpu/netlist_gen.mli b/cpu/netlist_gen.mli
index 67d4774..24cd6f1 100644
--- a/cpu/netlist_gen.mli
+++ b/cpu/netlist_gen.mli
@@ -1,7 +1,5 @@
type t
-val print : out_channel -> Netlist_ast.program -> unit
-
val get : Netlist_ast.ident -> t
val loop : int -> (t * (t -> t))
diff --git a/cpu/netlist_printer.ml b/cpu/netlist_printer.ml
new file mode 100644
index 0000000..2c80d70
--- /dev/null
+++ b/cpu/netlist_printer.ml
@@ -0,0 +1,82 @@
+open Netlist_ast
+open Format
+
+let rec print_env print lp sep rp ff env =
+ let first = ref true in
+ fprintf ff "%s" lp;
+ Env.iter
+ (fun x ty ->
+ if !first then
+ (first := false; fprintf ff "%a" print (x, ty))
+ else
+ fprintf ff "%s%a" sep print (x, ty)) env;
+ fprintf ff "%s" rp
+
+let rec print_list print lp sep rp ff = function
+ | [] -> ()
+ | x :: l ->
+ fprintf ff "%s%a" lp print x;
+ List.iter (fprintf ff "%s %a" sep print) l;
+ fprintf ff "%s" rp
+
+let print_ty ff n =
+ fprintf ff " : %d" n
+
+let print_bool ff b =
+ if b then
+ fprintf ff "1"
+ else
+ fprintf ff "0"
+
+let print_value ff a =
+ Array.iter (print_bool ff) a
+
+let print_arg ff arg = match arg with
+ | Aconst v -> print_value ff v
+ | Avar id -> fprintf ff "%s" id
+
+let print_op ff op = match op with
+ | And -> fprintf ff "AND"
+ | Nand -> fprintf ff "NAND"
+ | Or -> fprintf ff "OR"
+ | Xor -> fprintf ff "XOR"
+
+let print_exp ff e = match e with
+ | Earg a -> print_arg ff a
+ | Ereg x -> fprintf ff "REG %s" x
+ | Enot x -> fprintf ff "NOT %a" print_arg x
+ | Ebinop(op, x, y) -> fprintf ff "%a %a %a" print_op op print_arg x print_arg y
+ | Emux (c, x, y) -> fprintf ff "MUX %a %a %a " print_arg c print_arg x print_arg y
+ | Erom (addr, word, ra) -> fprintf ff "ROM %d %d %a" addr word print_arg ra
+ | Eram (addr, word, ra, we, wa, data) ->
+ fprintf ff "RAM %d %d %a %a %a %a" addr word
+ print_arg ra print_arg we
+ print_arg wa print_arg data
+ | Eselect (idx, x) -> fprintf ff "SELECT %d %a" idx print_arg x
+ | Econcat (x, y) -> fprintf ff "CONCAT %a %a" print_arg x print_arg y
+ | Eslice (min, max, x) -> fprintf ff "SLICE %d %d %a" min max print_arg x
+
+let print_eq ff (x, e) =
+ fprintf ff "%s = %a@." x print_exp e
+
+let print_var ff (x, ty) =
+ fprintf ff "@[%s%a@]" x print_ty ty
+
+let print_vars ff env =
+ fprintf ff "@[<v 2>VAR@,%a@]@.IN@,"
+ (print_env print_var "" ", " "") env
+
+let print_idents ff ids =
+ let print_ident ff s = fprintf ff "%s" s in
+ print_list print_ident """,""" ff ids
+
+let print_program oc p =
+ let ff = formatter_of_out_channel oc in
+ fprintf ff "INPUT %a@." print_idents p.p_inputs;
+ fprintf ff "OUTPUT %a@." print_idents p.p_outputs;
+ print_vars ff p.p_vars;
+ List.iter (print_eq ff) p.p_eqs;
+ (* flush *)
+ fprintf ff "@."
+
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 16:19:04 +0000