initial commit

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "minijazz"]
+	path = minijazz
+	url = https://github.com/inria-parkas/minijazz

tp1/_tags

@@ -0,0 +1,3 @@
+true: use_menhir
+<*.ml>: debug
+<*.byte>: use_unix, debug

tp1/graph.ml

@@ -0,0 +1,37 @@
+exception Cycle
+type mark = NotVisited | InProgress | Visited
+
+type 'a graph =
+    { mutable g_nodes : 'a node list }
+and 'a node = {
+  n_label : 'a;
+  mutable n_mark : mark;
+  mutable n_link_to : 'a node list;
+  mutable n_linked_by : 'a node list;
+}
+
+let mk_graph () = { g_nodes = [] }
+
+let add_node g x =
+  let n = { n_label = x; n_mark = NotVisited; n_link_to = []; n_linked_by = [] } in
+  g.g_nodes <- n::g.g_nodes
+
+let node_for_label g x =
+  List.find (fun n -> n.n_label = x) g.g_nodes
+
+let add_edge g id1 id2 =
+  let n1 = node_for_label g id1 in
+  let n2 = node_for_label g id2 in
+  n1.n_link_to <- n2::n1.n_link_to;
+  n2.n_linked_by <- n1::n2.n_linked_by
+
+let clear_marks g =
+  List.iter (fun n -> n.n_mark <- NotVisited) g.g_nodes
+
+let find_roots g =
+  List.filter (fun n -> n.n_linked_by = []) g.g_nodes
+
+let has_cycle g = failwith "Graph.has_cycle: Non implementé"
+
+let topological g = failwith "Graph.topological: Non implementé"
+

tp1/graph_test.ml

@@ -0,0 +1,28 @@
+open Graph
+
+let rec check l = match l with
+  | [] | [_] -> true
+  | s1::s2::l -> (String.length s1 <= String.length s2) && (check (s2::l))
+
+let test_good () =
+  let g = mk_graph () in
+  add_node g "1"; add_node g "21"; add_node g "22"; add_node g "333";
+  add_edge g "1" "21"; add_edge g "1" "22";
+  add_edge g "21" "333"; add_edge g "22" "333";
+  let l = topological g in
+  print_string "Test: Tri topologique --> ";
+  if check l then print_endline "OK" else print_endline "FAIL";
+  List.iter print_endline l;
+  print_newline ()
+
+let test_cycle () =
+  let g = mk_graph () in
+  add_node g "1"; add_node g "2"; add_node g "3";
+  add_edge g "1" "2"; add_edge g "2" "3"; add_edge g "3" "1";
+  print_string "Test: Detection de cycle --> ";
+  if has_cycle g then print_endline "OK" else print_endline "FAIL"
+;;
+
+test_cycle ();;
+test_good ();;
+

tp1/netlist.ml

@@ -0,0 +1,33 @@
+open Lexing
+
+exception Parse_error of string
+
+let find_file filename =
+  try
+    open_in filename
+  with
+    | _ -> raise (Parse_error ("No such file '"^filename^"%s'"))
+
+(** [read_file filename] reads the [filename] file and outputs the corresponding
+    Netlist_ast.program.*)
+let read_file filename =
+  let ic = find_file filename in
+  let lexbuf = from_channel ic in
+  lexbuf.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = filename };
+  try
+    Netlist_parser.program Netlist_lexer.token lexbuf
+  with
+    | e ->
+        let loc = Format.sprintf "line %d, column %d"
+          lexbuf.lex_curr_p.pos_lnum
+          (lexbuf.lex_curr_p.pos_cnum - lexbuf.lex_curr_p.pos_bol)
+        in
+        raise (Parse_error ("Syntax error at "^loc))
+
+(** [print_program oc p] prints the program [p] on the output channel [oc].
+    For instance, to print on the standard output, use [print_program stdout p].
+    To print to a file named 'filename', use the following:
+        let out = open_out filename in
+        print_program out p
+*)
+let print_program = Netlist_printer.print_program

tp1/netlist_ast.ml

@@ -0,0 +1,50 @@
+type ident = string
+
+(* Environment using ident as key *)
+module Env = struct
+  include Map.Make(struct
+    type t = ident
+    let compare = compare
+  end)
+
+  let of_list l =
+    List.fold_left (fun env (x, ty) -> add x ty env) empty l
+end
+
+type ty = TBit | TBitArray of int
+type value = VBit of bool | VBitArray of bool array
+
+type binop = Or | Xor | And | Nand
+
+(* argument of operators (variable or constant) *)
+type arg =
+    | Avar of ident (* x *)
+    | Aconst of value (* constant *)
+
+(* Expressions (see MiniJazz documentation for more info on the operators) *)
+type exp =
+    | Earg of arg (* a: argument *)
+    | Ereg of ident (* REG x : register *)
+    | Enot of arg (* NOT a *)
+    | Ebinop of binop * arg * arg (* OP a1 a2 : boolean operator *)
+    | Emux of arg * arg * arg (* MUX a1 a2 : multiplexer *)
+    | Erom of int (*addr size*) * int (*word size*) * arg (*read_addr*)
+        (* ROM addr_size word_size read_addr *)
+    | Eram of int (*addr size*) * int (*word size*)
+        * arg (*read_addr*) * arg (*write_enable*)
+        * arg (*write_addr*) * arg (*data*)
+        (* RAM addr_size word_size read_addr write_enable write_addr data *)
+    | Econcat of arg * arg (* CONCAT a1 a2 : concatenation of arrays *)
+    | Eslice of int * int * arg
+      (* SLICE i1 i2 a : extract the slice of a between indices i1 and i2 *)
+    | Eselect of int * arg
+      (* SELECT i a : ith element of a *)
+
+(* equations: x = exp *)
+type equation = ident * exp
+
+type program =
+    { p_eqs : equation list; (* equations *)
+      p_inputs : ident list; (* inputs *)
+      p_outputs : ident list; (* outputs *)
+      p_vars : ty Env.t; } (* maps variables to their types*)

tp1/netlist_lexer.mll

@@ -0,0 +1,41 @@
+{
+open Lexing
+open Netlist_parser
+exception Eof
+
+let keyword_list =
+[
+  "AND", AND;
+  "CONCAT", CONCAT;
+  "IN", IN;
+  "INPUT", INPUT;
+  "MUX", MUX;
+  "NAND", NAND;
+  "NOT", NOT;
+  "OR", OR;
+  "OUTPUT", OUTPUT;
+  "RAM", RAM;
+  "REG", REG;
+  "ROM", ROM;
+  "SELECT", SELECT;
+  "SLICE", SLICE;
+  "VAR", VAR;
+  "XOR", XOR;
+]
+
+}
+
+rule token = parse
+    '\n'
+      { new_line lexbuf; token lexbuf }     (* skip blanks *)
+  | [' ' '\t']
+      { token lexbuf }     (* skip blanks *)
+  | "="            { EQUAL }
+  | ":"            { COLON }
+  | ","            { COMMA }
+  | ['0'-'9']+ as lxm { CONST lxm }
+  | ('_' ? ['A'-'Z' 'a'-'z']('_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9']) * as id)
+      { let s = Lexing.lexeme lexbuf in
+        try List.assoc s keyword_list
+        with Not_found -> NAME id }
+  | eof            { EOF }

tp1/netlist_parser.mly

@@ -0,0 +1,76 @@
+%{
+ open Netlist_ast
+
+ let bool_of_string s = match s with
+  | "t" | "1" -> true
+  | "f" | "0" -> false
+  | _ -> raise Parsing.Parse_error
+
+ let bool_array_of_string s =
+   let a = Array.make (String.length s) false in
+   for i = 0 to String.length s - 1 do
+     a.(i) <- bool_of_string (String.sub s i 1)
+   done;
+   a
+
+ let value_of_const s =
+   let n = String.length s in
+   if n = 0 then
+     raise Parsing.Parse_error
+   else if n = 1 then
+     VBit (bool_of_string s)
+   else
+     VBitArray (bool_array_of_string s)
+%}
+
+%token <string> CONST
+%token <string> NAME
+%token AND MUX NAND OR RAM ROM XOR REG NOT
+%token CONCAT SELECT SLICE
+%token COLON EQUAL COMMA VAR IN INPUT OUTPUT
+%token EOF
+
+%start program             /* the entry point */
+%type <Netlist_ast.program> program
+
+%%
+program:
+  INPUT inp=separated_list(COMMA, NAME)
+    OUTPUT out=separated_list(COMMA, NAME)
+    VAR vars=separated_list(COMMA, var) IN eqs=list(equ) EOF
+    { { p_eqs = eqs; p_vars = Env.of_list vars; p_inputs = inp; p_outputs = out; } }
+
+equ:
+  x=NAME EQUAL e=exp { (x, e) }
+
+exp:
+  | a=arg { Earg a }
+  | NOT x=arg { Enot x }
+  | REG x=NAME { Ereg x }
+  | AND x=arg y=arg { Ebinop(And, x, y) }
+  | OR x=arg y=arg { Ebinop(Or, x, y) }
+  | NAND x=arg y=arg { Ebinop(Nand, x, y) }
+  | XOR x=arg y=arg { Ebinop(Xor, x, y) }
+  | MUX x=arg y=arg z=arg { Emux(x, y, z) }
+  | ROM addr=int word=int ra=arg
+    { Erom(addr, word, ra) }
+  | RAM addr=int word=int ra=arg we=arg wa=arg data=arg
+    { Eram(addr, word, ra, we, wa, data) }
+  | CONCAT x=arg y=arg
+     { Econcat(x, y) }
+  | SELECT idx=int x=arg
+     { Eselect (idx, x) }
+  | SLICE min=int max=int x=arg
+     { Eslice (min, max, x) }
+
+arg:
+  | n=CONST { Aconst (value_of_const n) }
+  | id=NAME { Avar id }
+
+var: x=NAME ty=ty_exp { (x, ty) }
+ty_exp:
+  | /*empty*/ { TBit }
+  | COLON n=int { TBitArray n }
+
+int:
+  | c=CONST { int_of_string c }

tp1/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 ty = match ty with
+  | TBit -> ()
+  | TBitArray n -> fprintf ff " : %d" n
+
+let print_bool ff b =
+  if b then
+    fprintf ff "1"
+  else
+    fprintf ff "0"
+
+let print_value ff v = match v with
+  | VBit b -> print_bool ff b
+  | VBitArray 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 "@."

tp1/netlist_simulator.ml

@@ -0,0 +1,26 @@
+let print_only = ref false
+let number_steps = ref (-1)
+
+let simulator program number_steps = failwith "netlist_simulator.simulator: Non implementé"
+
+let compile filename =
+  try
+    let p = Netlist.read_file filename in
+    begin try
+        let p = Scheduler.schedule p in
+        simulator p !number_steps
+      with
+        | Scheduler.Combinational_cycle ->
+            Format.eprintf "The netlist has a combinatory cycle.@.";
+    end;
+  with
+    | Netlist.Parse_error s -> Format.eprintf "An error accurred: %s@." s; exit 2
+
+let main () =
+  Arg.parse
+    ["-n", Arg.Set_int number_steps, "Number of steps to simulate"]
+    compile
+    ""
+;;
+
+main ()