Téléverser un nouveau fichier

netlist_simulator.ml

+open Netlist_ast
+
+let number_steps = ref (-1)
+let steps=ref 1
+let vars=Hashtbl.create 10
+let regs=ref (Hashtbl.create 10)
+let bitarray8_of_int i=
+  let rec aux n e=match e with
+    |0->[]
+    |_->(n mod 2)::(aux (n/2) (e-1)) 
+  in Array.of_list (List.rev (aux i 8))
+let file = open_in_bin "../command.rom" 
+let rec readRom () =
+  try let t=input_byte file in (bitarray8_of_int t)::(readRom ())
+  with
+    |End_of_file -> []
+
+let rom=Array.concat (readRom ())
+let ram=Hashtbl.create 10
+let oldram=ref (Hashtbl.create 10)
+let saletruc=ref 0
+
+let rec int_of_value v=match v with
+	|VBit false->0
+	|VBit true->1
+	|VBitArray vba->Array.fold_right (fun b n->2*n+int_of_value (VBit b)) vba 0
+
+let bitarray_of_value v=match v with
+	|VBit vb->Array.make 1 vb
+	|VBitArray vba->vba
+
+let print_arg a=match a with
+	|Avar v->print_string v
+	|Aconst c->print_string "//TODO"
+	
+let rec read_input var=
+	(*On ne vérifie pas que les types sont bons parce que c'est géré bizarrement par
+	netlist_ast.ml, et ce n'est pas essentiel pour le fonctionnement du simulateur*)
+	print_string (var^" ? ");
+	match (read_line ()) with
+		|"0"->Hashtbl.replace vars var (VBit false)
+		|"1"->Hashtbl.replace vars var (VBit true)
+		|s->let vba=Array.make (String.length s) true in
+			let bon=ref true in
+			for i=0 to ((String.length s)-1) do
+				match String.get s i with
+				|'0'->Array.set vba i false
+				|'1'->Array.set vba i true
+				|_->bon:=false
+			done;
+			if !bon then Hashtbl.replace vars var (VBitArray vba) else read_input var
+
+let print_bit b=match b with
+	|true->print_int 1
+	|false->print_int 0
+
+let print_value v=match v with
+	|VBit b->print_bit b
+	|VBitArray vba->Array.iter print_bit vba
+	
+let disp_output var=
+	print_string ("=> "^var^" = ");
+	print_value (Hashtbl.find vars var);
+	print_newline ()
+
+	(*binop->bool->bool->bool*)
+let calc_binop bop vb1 vb2=match bop with
+	|Or->vb1||vb2
+	|Xor->(vb1||vb2)&&(not (vb1&&vb2))
+	|And->vb1&&vb2
+	|Nand->not (vb1&&vb2)
+
+	(*bool->bool->bool->bool*)
+let calc_mux mux vb1 vb2=if mux then vb2 else vb1
+	
+	(*arg->value*)
+let calc_arg arg=match arg with
+	|Avar v->Hashtbl.find vars v
+	|Aconst c->c
+
+	(*exp->value*)
+let calc_exp exp=match exp with
+	|Earg a->calc_arg a
+	|Ereg x->Hashtbl.find !regs x
+	|Enot a->let va=calc_arg a in begin
+		match va with
+			|VBit vb->VBit (not vb)
+			|VBitArray vba->VBitArray (Array.map not vba) 
+		end
+	|Ebinop (bop,a,b)->begin
+		match calc_arg a,calc_arg b with
+			|VBit vb1,VBit vb2->VBit (calc_binop bop vb1 vb2)
+			|VBitArray vba1,VBitArray vba2->VBitArray (Array.map2 (calc_binop bop) vba1 vba2)
+			|_,_->failwith "Two types don't match"
+		end
+	|Emux (mux,a,b)->begin
+		match calc_arg mux,calc_arg a,calc_arg b with
+			|VBit vbmux,VBit vb1,VBit vb2->VBit (calc_mux vbmux vb1 vb2)
+			|VBitArray vbamux,VBitArray vba1,VBitArray vba2->VBitArray Array.(mapi (fun i x->calc_mux x (get vba1 i) (get vba2 i)) vbamux)
+			|_,_,_->failwith "Two types don't match"
+		end
+	|Erom (addr_size,word_size,read_addr)->
+		let aux i p=
+		try
+			match Array.get rom (word_size*(int_of_value (calc_arg read_addr))+i) with
+			|0->false
+			|_->true
+		with 
+			|Invalid_argument a->false
+		in VBitArray (Array.mapi aux (Array.make word_size 0))
+ |Eram (addr_size,word_size,read_addr,write_enable,write_addr,data)->saletruc:=!saletruc+100;
+     begin if (int_of_value (calc_arg write_enable))=1 then 
+		let aux1 i p=
+			Hashtbl.add ram (word_size*((int_of_value (calc_arg write_addr)))+i+(!saletruc)) (Array.get (bitarray_of_value (calc_arg data)) i)
+		in Array.iteri aux1 (bitarray_of_value (calc_arg data)) end;
+		let aux2 i p=
+		try
+			Hashtbl.find !oldram (word_size*((int_of_value (calc_arg read_addr)))+i+(!saletruc))
+		with 
+			|Not_found->false in
+		VBitArray (Array.mapi aux2 (Array.make word_size 0))
+	|Econcat (a,b)->VBitArray (Array.append (bitarray_of_value (calc_arg a)) (bitarray_of_value (calc_arg b)))
+	|Eslice (i1,i2,a)->begin
+		match calc_arg a with
+			|VBitArray vba when (i1<=i2)&&(i2<(Array.length vba))->VBitArray (Array.sub vba i1 (i2-i1+1))
+			|VBitArray vba->print_int i1;print_int i2;print_arg a;print_int (Array.length vba);failwith "Invalid arguments were given to a slicing instruction"
+			|_->failwith "Only arrays can be sliced"
+		end
+	|Eselect (i,a)->begin
+		match calc_arg a with
+			|VBitArray vba when (i<(Array.length vba))->VBit (Array.get vba i)
+			|VBitArray vba->failwith "Select index out of bounds"
+			|_->print_arg a;failwith "Selection is only possible in an array"
+		end
+	
+	(*eq->unit*)
+let process_eq eq=
+	(*On ne vérifie pas que les types sont bons parce que c'est géré bizarrement par
+	netlist_ast.ml, et ce n'est pas essentiel pour le fonctionnement du simulateur*)
+	Hashtbl.replace vars (fst eq) (calc_exp (snd eq))
+	
+let execute filename=
+    try
+    let p = Netlist.read_file filename in
+	List.iter (fun x->Hashtbl.add vars x (VBit false)) p.p_inputs;
+	List.iter (fun x->Hashtbl.add vars (fst x) (match Env.find (fst x) p.p_vars with
+		|TBit->VBit false
+		|TBitArray n->VBitArray (Array.make n false))) p.p_eqs;
+	(*On renverra une erreur si il faut afficher une variable qui n'est jamais assignée*)
+    while (!number_steps=(-1)) || (!number_steps>=(!steps)) do
+      print_endline ("Step "^(string_of_int !steps)^":");
+      saletruc:=0;
+		List.iter read_input p.p_inputs;
+		regs:=Hashtbl.copy vars;
+		oldram:=Hashtbl.copy ram;
+        List.iter process_eq p.p_eqs;
+		List.iter disp_output p.p_outputs;
+        steps:=!steps+1
+    done;
+  with
+    | Netlist.Parse_error s -> Format.eprintf "An error occurred: %s@." s; exit 2
+
+let main () =
+  Arg.parse
+    ["-n", Arg.Set_int number_steps, "Number of steps to simulate"]
+    execute
+    ""
+;;
+
+main ()