diff options
| -rw-r--r-- | cpu/alu.ml | 98 | ||||
| -rw-r--r-- | cpu/cpu.ml | 2 | ||||
| -rw-r--r-- | cpu/netlist_gen.ml | 70 | ||||
| -rw-r--r-- | cpu/netlist_gen.mli | 2 | ||||
| -rw-r--r-- | cpu/netlist_printer.ml | 82 | ||||
| -rw-r--r-- | cpu/os.asm | 93 | ||||
| -rw-r--r-- | plan_micro.pdf | bin | 79315 -> 80846 bytes | |||
| -rw-r--r-- | plan_micro.tm | 8 | ||||
| -rw-r--r-- | sched/netlist_lexer.mll | 9 |
9 files changed, 285 insertions, 79 deletions
@@ -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 *) @@ -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 "@." + + @@ -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 Binary files differindex 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 } |