Merge branch 'jonathan' ; add unit tests.

Conflicts:
	cpu/alu.ml

9 files changed, 285 insertions, 79 deletions

diff --git a/cpu/alu.ml b/cpu/alu.ml
index 828856c..96e2ae4 100644
--- a/cpu/alu.ml
+++ b/cpu/alu.ml
@@ -53,20 +53,102 @@ 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
 
-let rec nmul n a b start_signal =
-    zeroes n, zeroes n, start_signal (* TODO : retuns lo and hi part of 32-bit answer *)
 
-let rec ndiv n a b start_signal =
-    zeroes n, zeroes n, start_signal (* TODO : returns quotient and remainder *)
 
-let rec nmulu n a b start_signal =
-    zeroes n, zeroes n, start_signal (* TODO : same as nmul but unsigned *)
+
+(* 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 nmulu n a b start_signal =
+  let next_busy, set_next_busy = loop 1 in
+  let busy = start_signal ^| (reg 1 next_busy) in
+
+  let res, set_res = loop (2*n) in
+  let t_res = mux start_signal (const "0" ++ ((reg (2*n) res) % (0, 2*n-2))) (zeroes (2*n)) in
+  let mul, set_mul = loop n in
+  let mul = set_mul (mux start_signal (((reg n mul) % (1, n-1)) ++ const "0") b) in
+  let add = nonnull n mul in
+  let res = set_res (mux add t_res (nadder (2*n) (a ++ zeroes n) t_res)) in
+
+  let finished = 
+    set_next_busy (busy ^& add) ^.
+    (not add) ^& busy in
+
+  res % (0, n-1), res % (n, 2*n-1), finished
+
+
 
 let rec ndivu n a b start_signal =
-    zeroes n, zeroes n, start_signal (* TODO : save as ndiv but unsigned *)
+    zeroes n, zeroes n, start_signal (* TODO : unsigned division, returns quotient and remainder *)
+
+let rec nmul n a b start_signal =
+    zeroes n, zeroes n, start_signal (* TODO : signed multiplication ; returns low part and high part *)
+
+
+let rec ndiv n a b start_signal =
+    zeroes n, zeroes n, start_signal (* TODO : signed division *)
+
 
 (* Shifts *)
 
diff --git a/cpu/cpu.ml b/cpu/cpu.ml
index 75d1c56..14b1f2a 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 "@."
+
+
diff --git a/cpu/os.asm b/cpu/os.asm
index fd8c50f..c7abde3 100644
--- a/cpu/os.asm
+++ b/cpu/os.asm
@@ -4,6 +4,8 @@
 #       all registers are caller-saved, except SP which is preserved by function calls
 
 .text
+    jal run_unit_tests 
+
     li A msghello
     jal ser_out_msg
 
@@ -90,6 +92,81 @@ add_b_to_string:
     jz A check_input
 check_input_ret:
     jr RA
+
+# PROCEDURE: run_unit_tests
+# ROLE: check that CPU features work correctly ; displays message to serial output
+# ARGUMENTS: none
+run_unit_tests:
+  push RA
+  
+  li A testbegin
+  jal ser_out_msg
+
+  li A test0
+  jal ser_out_msg
+  jal unit_test_0
+  li A testfail
+  jz B t0fail
+  li A testok
+t0fail:
+  jal ser_out_msg
+
+  li A test1
+  jal ser_out_msg
+  jal unit_test_1
+  li A testfail
+  jz B t1fail
+  li A testok
+t1fail:
+  jal ser_out_msg
+
+  li A test2
+  jal ser_out_msg
+  jal unit_test_2
+  li A testfail
+  jz B t2fail
+  li A testok
+t2fail:
+  jal ser_out_msg
+
+  li A test3
+  jal ser_out_msg
+  jal unit_test_3
+  li A testfail
+  jz B t2fail
+  li A testok
+t3fail:
+  jal ser_out_msg
+
+  pop RA
+  jr RA
+
+unit_test_0:
+  li B 1
+
+  li C 12
+  li D 44
+  add C C D
+  sei A C 56
+  and B B A
+
+  li C -7
+  li D 7
+  add C C D
+  se A C Z
+  and B B A
+
+  jr RA
+unit_test_1:
+  li B 1
+  jr RA
+unit_test_2:
+  li B 1
+  jr RA
+unit_test_3:
+  li B 1
+  jr RA
+
     
 
 # READ-ONLY PROGRAM DATA
@@ -104,6 +181,22 @@ endl:
 error:
     ascii "Sorry but I'm to stupid to understand that.\n"
 
+testbegin:
+  ascii "Runing CPU unit tests...\n"
+testok:
+  ascii "OK\n"
+testfail:
+  ascii "FAIL\n"
+test0:
+  ascii "Addition/substraction: "
+test1:
+  ascii "Unsigned multiplication: "
+test2:
+  ascii "Unsigned division: "
+test3:
+  ascii "Signed division/multiplication: "
+
+
 
 .data
 # Space where command-line is buffered from serial input
diff --git a/plan_micro.pdf b/plan_micro.pdf
index e67dc86..d1e0dcc 100644
--- a/plan_micro.pdf
+++ b/plan_micro.pdf
diff --git a/plan_micro.tm b/plan_micro.tm
index 0c6020e..158ffb5 100644
--- a/plan_micro.tm
+++ b/plan_micro.tm
@@ -137,8 +137,10 @@
   (16 bits)>|<cell|>>|<row|<cell|10110>|<cell|R>|<cell|*>|<cell|lbr>|<cell|<math|R<rsub|lo>\<leftarrow\>mem<around*|(|R<rsub|A>+R<rsub|B>|)>
   ; R<rsub|hi>\<leftarrow\>0> (8 bits)>|<cell|>>|<row|<cell|10111>|<cell|R>|<cell|*>|<cell|sbr>|<cell|<math|mem<around*|(|R<rsub|A>+R<rsub|B>|)>\<leftarrow\>R<rsub|lo><rsup|>>
   (8 bits)>|<cell|>>|<row|<cell|11000>|<cell|I>|<cell|>|<cell|lil>|<cell|<math|R<rsub|lo>\<leftarrow\>d>>|<cell|>>|<row|<cell|11001>|<cell|I>|<cell|>|<cell|lilz>|<cell|<math|R<rsub|lo>\<leftarrow\>d
-  ; R<rsub|hi>\<leftarrow\>0>>|<cell|>>|<row|<cell|11010>|<cell|I>|<cell|>|<cell|liu>|<cell|<math|R<rsub|hi>\<leftarrow\>d>>|<cell|>>|<row|<cell|11011>|<cell|I>|<cell|>|<cell|liuz>|<cell|<math|R<rsub|hi>\<leftarrow\>d
-  ; R<rsub|lo>\<leftarrow\>0>>|<cell|>>|<row|<cell|11100>|<cell|>|<cell|<em|>>|<cell|<em|nop>>|<cell|>|<cell|>>|<row|<cell|11101>|<cell|>|<cell|>|<cell|<em|nop>>|<cell|>|<cell|>>|<row|<cell|11110>|<cell|>|<cell|>|<cell|<em|nop>>|<cell|>|<cell|>>|<row|<cell|11111>|<cell|>|<cell|>|<cell|nop<samp|>>|<cell|<math|\<varnothing\>>>|<cell|>>>>>|Instructions
+  ; R<rsub|hi>\<leftarrow\>0>>|<cell|(<math|d> non
+  signé)>>|<row|<cell|11010>|<cell|I>|<cell|>|<cell|liu>|<cell|<math|R<rsub|hi>\<leftarrow\>d>>|<cell|>>|<row|<cell|11011>|<cell|I>|<cell|>|<cell|liuz>|<cell|<math|R<rsub|hi>\<leftarrow\>d
+  ; R<rsub|lo>\<leftarrow\>0>>|<cell|>>|<row|<cell|11100>|<cell|I>|<cell|<em|>>|<cell|lie>|<cell|<math|R\<leftarrow\>sign_extend<rsub|8><rsup|16><around*|(|d|)>>>|<cell|(<math|d>
+  signé)>>|<row|<cell|11101>|<cell|>|<cell|>|<cell|<em|nop>>|<cell|>|<cell|>>|<row|<cell|11110>|<cell|>|<cell|>|<cell|<em|nop>>|<cell|>|<cell|>>|<row|<cell|11111>|<cell|>|<cell|>|<cell|nop<samp|>>|<cell|<math|\<varnothing\>>>|<cell|>>>>>|Instructions
   reconnues par le microproceseur>
 
   L'assembleur propose également quelques instructions \S étendues \T
@@ -181,7 +183,7 @@
     <associate|auto-11|<tuple|5|2>>
     <associate|auto-12|<tuple|4|2>>
     <associate|auto-13|<tuple|3|3>>
-    <associate|auto-14|<tuple|4|5>>
+    <associate|auto-14|<tuple|4|4>>
     <associate|auto-15|<tuple|5|?>>
     <associate|auto-16|<tuple|4|?>>
     <associate|auto-17|<tuple|5|?>>
diff --git a/sched/netlist_lexer.mll b/sched/netlist_lexer.mll
index 60cb223..ec27367 100644
--- a/sched/netlist_lexer.mll
+++ b/sched/netlist_lexer.mll
@@ -1,5 +1,6 @@
 {
 open Netlist_parser
+open Lexing
 exception Eof
 
 let keyword_list =
@@ -22,10 +23,16 @@ let keyword_list =
   "XOR", XOR;
 ]
 
+let newline lexbuf =
+  let pos = lexbuf.lex_curr_p in
+  lexbuf.lex_curr_p <- 
+    { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum }
+
 }
 
 rule token = parse
-    [' ' '\t' '\n']     { token lexbuf }     (* skip blanks *)
+  | '\n'          { newline lexbuf ; token lexbuf }
+  |  [' ' '\t']     { token lexbuf }     (* skip blanks *)
   | "="            { EQUAL }
   | ":"            { COLON }
   | ","            { COMMA }