main.ml 16.3 KB
Newer Older
1
2
open Ast
open Printer
3
open Unix
4
5
6
7

(* Wrong_type (equ_id, arg, type_obtained) *)
exception Wrong_type of ident * arg  * ty
(* Index_out_of_bounds equ_id *)
Quentin Aristote's avatar
Quentin Aristote committed
8
9
10
exception Out_of_bounds of ident
    
(*Computation of current soviet date *)
11
let date_soviet () =
Quentin Aristote's avatar
Quentin Aristote committed
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 let date = Unix.gmtime (Unix.time ()) in
 let year = 1900 + date.tm_year in
 let bis = if (year - 2016) mod 4 = 0 then 1 else 0 in
 let sec = date.tm_sec in
 let min = date.tm_min in
 let hour = date.tm_hour + 1 in
 let month, day, ferie, travailleur =
   (match date.tm_yday with
     | i when -1 <i && i < 31 ->
         1, i, 0, i mod 5 + 1
     | i when i = 31->
         1, 31, 1, 0
     | i when 31 < i && i < 63 ->
         2, i - 31, 0, (i - 31) mod 5 + 1
     | i when i = 63 && bis = 1 ->
         2, 31, 6, 0
     | i when 62 < i - bis && i - bis < 93 ->
         3, i - 62 - bis, 0, (i - 62 - bis) mod 5 + 1
     | i when 92 < i - bis && i - bis < 123 ->
         4, i - 92 - bis, 0, (i - 92 - bis) mod 5 + 1
     | i when i - bis = 123 ->
         4, i - 92 - bis, 2, 0
     | i when i - bis = 124 ->
         4, i - 92 - bis, 3, 0
     | i when 124 < i - bis && i - bis < 155 ->
         5, i - 124 - bis, 0, (i - 124 - bis) mod 5 + 1
     | i when 154 < i - bis && i - bis < 185 ->
         6, i - 154 - bis, 0, (i - 154 - bis) mod 5 + 1
     | i when 184 < i - bis && i - bis < 215 ->
         7, i - 184 - bis, 0, (i - 184 - bis) mod 5 + 1
     | i when 214 < i - bis && i - bis < 245 ->
         8, i - 214 - bis, 0, (i - 214 - bis) mod 5 + 1
     | i when 244 < i - bis && i - bis < 275 ->
         9, i - 244 - bis, 0, (i - 244 - bis) mod 5 + 1
     | i when 274 < i - bis && i - bis < 305 ->
         10, i - 274 - bis, 0, (i - 274 - bis) mod 5 + 1
     | i when 304 < i - bis && i - bis < 335 ->
         11, i - 304 - bis, 0, (i - 304 - bis) mod 5 + 1
     | i when i - bis = 335 ->
         11, i - 304 - bis, 4, 0
     | i when i - bis = 336 ->
         11, i - 304 - bis, 5, 0
     | i when 336 < i - bis && i - bis < 357 ->
         12, i - 336 - bis, 0, (i - 336 - bis) mod 5 + 1
     | _ -> failwith "day out of range") in
 (sec, min, hour, day, month, year, travailleur, ferie)
58
59
60
61
62
63
64
65
66
67
68

(* Integer <-> boolean *)
let bool_of_bit = function
  | 0 -> false
  | 1 -> true
  | _ -> raise (Invalid_argument "bool_of_bit")

let bit_of_bool = function
  | false -> 0
  | true -> 1

69
let pow2 n = 1 lsl n
70
71
72
73
74
75
76
77
78
79
80
81
82
83

(* Prints a type fully. Used to print error messages. *)
let print_type ff t = match t with
  | TBit -> Format.fprintf ff "Bit"
  | TBitArray n -> Format.fprintf ff "BitArray %d" n

(* Outputs the value of an argument *)
let eval_arg env = function
  | Avar id -> Env.find id env
  | Aconst v -> v

(* Converts an address from BitArray to integer *)
let eval_addr env a = match eval_arg env a with
  | VBitArray t -> (* big-endian, but could be small-endian *)
84
      Array.fold_left (fun n b -> 2 * n + bit_of_bool b) 0 t
85
86
87
88
89
  | VBit b -> bit_of_bool b

(* Evaluates an equation *)              
let eval_expr env roms rams id = function
  | Earg a ->
90
      eval_arg env a
91
92
  | Ereg x -> (* Outputs the good value as scheduler.ml has 
                 _ = REG _ equations evaluated before everything else *)
93
      Env.find x env 
94
95
  | Enot a -> begin
      match eval_arg env a with
96
        | VBit b -> VBit (not b)
Quentin Aristote's avatar
Quentin Aristote committed
97
        | VBitArray t when Array.length t = 1 -> VBitArray [|not t.(0)|]
98
        | VBitArray t -> raise (Wrong_type (id, a, TBitArray (Array.length t)))
99
100
    end
  | Ebinop (op, a1, a2) -> begin
101
102
103
104
105
106
107
108
109
110
111
112
      match (eval_arg env a1, eval_arg env a2) with
        | (VBit b1, VBit b2) -> VBit (match op with
                                       | Or -> b1 || b2
                                       | And -> b1 && b2
                                       | Xor -> (b1 && not b2) || (not b1 && b2)
                                       | Nand -> not (b1 || b2))
        | (VBitArray t, _) -> raise (Wrong_type (id,
                                                 a1,
                                                 TBitArray (Array.length t)))
        | (_, VBitArray t) -> raise (Wrong_type (id,
                                                 a2,
                                                 TBitArray (Array.length t)))
113
114
115
    end
  | Emux (s, a1, a2) -> begin
      match eval_arg env s with
116
117
        | VBit true  | VBitArray [|true|]  -> eval_arg env a1
        | VBit false | VBitArray [|false|] -> eval_arg env a2
118
        | VBitArray t -> raise (Wrong_type (id, s, TBitArray (Array.length t)))
119
    end
120
121
122
123
124
125
126
  | Erom (_, word_size, read_addr) -> begin
      try
          VBitArray (Env.find id roms).(eval_addr env read_addr)
        with
          | Invalid_argument _ -> VBitArray (Array.make word_size false)
      end
  | Eram (_, _, read_addr, _, _, _) ->
127
128
129
      (* The writing part of this instruction is done after 
         all variables have seen their value computed. *)
      VBitArray (Env.find id rams).(eval_addr env read_addr)
130
131
  | Econcat (a1, a2) -> begin
      match eval_arg env a1, eval_arg env a2 with
132
133
134
135
        | VBitArray t1, VBitArray t2 -> VBitArray (Array.append t1 t2)
        | VBitArray t, VBit b -> VBitArray (Array.append t [|b|])
        | VBit b, VBitArray t -> VBitArray (Array.append [|b|] t)
        | VBit b1, VBit b2 -> VBitArray [|b1; b2|]
136
137
138
    end
  | Eslice (i1, i2, a) -> begin
      match eval_arg env a with
139
140
141
142
143
144
145
        | VBitArray t -> begin
            try
              VBitArray (Array.sub t i1 (i2 - i1 + 1))
            with
              | Invalid_argument _ -> raise (Out_of_bounds id)
          end
        | _ -> raise (Wrong_type (id, a, TBit))
146
147
148
    end
  | Eselect (i, a) -> begin
      match eval_arg env a with
149
150
151
152
153
154
        | VBitArray t -> begin
            try
              VBit t.(i)
            with
              | Invalid_argument _ -> raise (Out_of_bounds id)
          end
155
        | VBit b when i = 0 -> VBit b
156
        | _ -> raise (Out_of_bounds id)
157
158
159
160
161
162
    end

(* Asks the user to input variable <id> and outputs the value 
   that was read. Since this function is tail-recursive, there   
   shouldn't be any problem how much wrong inputs there are. *)
let rec read_value id t =
163
164
165
  let input_length = match t with
    | TBit | TBitArray 1 -> 1
    | TBitArray n -> n in
166
167
168
169
  Printf.printf "%s (%d bit%s) = "
    id
    input_length
    (if input_length <= 1 then "" else "s");
170
171
  let input = read_line () in
  try
172
173
174
175
176
    let v = Array.init
              (String.length input)
              (fun i -> match input.[i] with
                  | '0' -> false
                  | '1' -> true
Quentin Aristote's avatar
Quentin Aristote committed
177
                  | c -> raise (Invalid_argument ("character : "
178
179
180
181
                                                  ^ (String.make 1 c)))) in
    match input_length with
      | 1 when Array.length v = 1 -> VBit v.(0)
      | n when Array.length v = n -> VBitArray v
182
183
      | _ -> raise (Invalid_argument
                      (Format.sprintf "length : %d" (Array.length v)))
184
  with
185
186
    | Invalid_argument s -> Format.printf "Wrong input %s.@." s;
        read_value id t
187
188
189
190
191

(* Variables set when the program is called through the command line *)
let print_only = ref false
let number_steps = ref (-1)
let rom_directory = ref "./"
Quentin Aristote's avatar
Quentin Aristote committed
192
let cycle_duration = ref 0.
193

194
195
(* The main part of the program *)
let compile filename =
196

197
  (* We first check for any combinational cycle and order the netlist. *)
198
  Format.printf "scheduling ...@." ;
199
  let p = try
200
201
    Scheduler.schedule (Netlist.read_file filename)
  with 
202
    | Scheduler.Combinational_cycle ->
203
204
205
        Format.eprintf
          "The netlist has a combinatory cycle.@.";
        exit 2
206
    | Netlist.Parse_error s ->
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
        Format.eprintf
          "An error occurred during parsing : %s@."
          s;
        exit 2 in

  (* If the user asked to, we only write <filename>_sch.net.*)
  if !print_only then (
    let out =
      open_out ((Filename.chop_suffix filename ".net") ^ "_sch.net") in
    print_program out p;
    close_out out

    (* Otherwise we simulate the netlist. *)
  ) else ( 
    (* --- Initialization ---
       - env : stores variables 
       - roms : stores the ROM blocks
       - rams : stores the RAM blocks
       - i : counts the steps *)
Quentin Aristote's avatar
Quentin Aristote committed
226
    let env  = ref Env.empty in
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
    let roms = ref Env.empty in
    let rams = ref Env.empty in

    (* We go through the equations to initialize the memory. *)
    List.iter
      (fun (id, expr) -> match expr with
          | Ereg x ->
              (* Give a default value to each variable
                 that is the argument of a register. *)
              env := Env.add
                       x
                       (match Env.find id p.p_vars with
                         | TBit -> VBit false
                         | TBitArray n -> VBitArray (Array.make n false))
                       !env
Quentin Aristote's avatar
Quentin Aristote committed
242

243
          | Erom (_, word_size, _) ->
244
245
246
              (* Loads the ROM block associated 
                 to each variable whose value is
                 read through a ROM statement. *)
247
              Format.printf "loading rom ...@." ;
248
249
              let file = (* Tries to open <id>.rom *)
                try
Quentin Aristote's avatar
Quentin Aristote committed
250
                  open_in_bin "/home/qaristote/documents/DI/SystèmeDigital/microprocesseur/command.rom" (*(!rom_directory ^ id ^ ".rom")*)
251
                with
252
253
254
                  | Sys_error s when (s = !rom_directory ^
                                          id ^
                                          ".rom: No such file or directory"
255
256
257
258
259
                                      || s = "Is a directory") ->
                      Format.eprintf
                        "%s.rom either does not exist or is a directory."
                        id;
                      exit 2 in
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
              let bits = ref [] in
              let size = ref 0 in
              begin try
                while true do
                  let n = (* Tries to read from <id>.rom *)
                    input_byte file in
                  for j = 7 downto 0 do
                    bits := bool_of_bit ((n / (pow2 j)) mod 2) :: !bits ;
                    size := !size + 1
                  done ;
                done ;
              with
                | End_of_file -> () end ;
              close_in file ;
              
              bits := List.rev !bits ;
              let r = Array.init
                        (!size / word_size)
                        (fun i -> Array.init
                                    word_size
                                    (fun i ->
                                       try
                                         let result = List.hd !bits in
                                         bits := List.tl !bits ;
                                         result
                                       with
                                         | Failure _ -> false)) in
287
              roms := Env.add id r !roms
288
289
290
291

          | Eram (addr_size, word_size, _, _, _, _) ->
              (* Creates an empty RAM block for each variable
                 whose value is read through a RAM statement *)
Quentin Aristote's avatar
Quentin Aristote committed
292

293
294
295
296
297
298
299
300
              rams := Env.add
                        id
                        (Array.make
                           (pow2 addr_size)
                           (Array.make word_size false))
                        !rams
          | _ -> ())
      p.p_eqs;
Quentin Aristote's avatar
Quentin Aristote committed
301

Quentin Aristote's avatar
Quentin Aristote committed
302
    
303
    let i = ref 0 in
Quentin Aristote's avatar
Quentin Aristote committed
304
305
    let start_time = ref (Unix.time ()) in
    while !i <> !number_steps do
306
      (* --- Input ---
307
308
           For each variable in p.p_inputs, we 
           ask for its value and add it to env *)
Quentin Aristote's avatar
Quentin Aristote committed
309

310
311
312
313
314
315
316
317
318
319
320
321
322
323
      env := (List.fold_left
                (fun tmp id -> Env.add
                                 id
                                 (read_value id (Env.find id p.p_vars))
                                 tmp)
                !env
                p.p_inputs);

      (* --- Execution ---
         For each equation in p.p_eqs, we evaluate it 
         and update the associated variable in env.
         For _ = RAM _ equations, we first compute 
         the values of all the variables for the
         current cycle and only then write into the RAM. *)
Quentin Aristote's avatar
Quentin Aristote committed
324

325
326
327
328
329
330
331
332
333
334
335
      begin try
        (* We update the value of all the variables. *)
        env := List.fold_left
                 (fun tmp (id, expr) -> Env.add
                                          id
                                          (eval_expr tmp !roms !rams id expr)
                                          tmp)
                 !env
                 p.p_eqs;
        (* Only now that we know every variable 
           can we write in the RAM blocks. *)
336
        List.iter
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
          (fun (id, expr) ->
             match expr with
               | Eram (_, word_size, _, write_enable, write_addr, data) -> begin
                   match eval_arg !env write_enable with
                     | VBit true -> begin
                         match eval_arg !env data with
                           | VBit b ->
                               if word_size = 1 then
                                 (Env.find id !rams).(eval_addr !env write_addr)
                                 <- [|b|]
                               else
                                 raise (Wrong_type (id,
                                                    data,
                                                    TBit))
                           | VBitArray t ->
                               if word_size = Array.length t then
                                 (Env.find id !rams).(eval_addr !env write_addr)
                                 <- t
                               else
                                 raise (Wrong_type (id,
                                                    data,
                                                    TBitArray (Array.length t)))
                       end
                     | VBit false -> ()
                     | VBitArray t ->
                         raise (Wrong_type (id,
                                            write_enable,
                                            TBitArray (Array.length t)))
Quentin Aristote's avatar
Quentin Aristote committed
365
                 end
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
               | _ -> ())
          p.p_eqs;
      with
        | Wrong_type (id, a, t) ->
            (* This exception should never be caught unless the user wrote 
               or modified the netlist manually, without MiniJazz. *)
            Format.eprintf
              "While evaluating %s, %a was expected to be of type %a but was of type %a.@."
              id
              print_arg a
              (fun ff arg -> match arg with
                  | Aconst (VBit _) ->
                      print_type ff TBit
                  | Aconst (VBitArray t) ->
                      print_type ff (TBitArray (Array.length t))
                  | Avar x ->
                      print_type ff (Env.find x p.p_vars)) a
              print_type t;
            exit 2
      end;

      (* --- Output ---
         For each variable in p.p_outputs, 
         we print it in stdout *)
      List.iter
        (fun id -> try
392
393
394
395
396
           let value = Env.find id !env in
           Format.printf "=> %s = %a -> 0x%x@."
             id print_value
             value
             (eval_addr !env (Aconst value))
397
398
399
400
401
402
         with
           | Not_found -> Format.eprintf "Outbound output variable %s.@." id;
               exit 2)
        p.p_outputs;

      (* --- Update --- *)
Quentin Aristote's avatar
Quentin Aristote committed
403
      let end_time = Unix.time () in
Quentin Aristote's avatar
Quentin Aristote committed
404
      Unix.sleepf (!cycle_duration -. end_time +. !start_time);
Quentin Aristote's avatar
Quentin Aristote committed
405
      start_time := end_time ;
406
      i := 1 + !i;
Quentin Aristote's avatar
Quentin Aristote committed
407
done)
408

409
410
411
412
let main () =
  Arg.parse
    ["-print", Arg.Set print_only, "Only print the result of scheduling";
     "-n", Arg.Set_int number_steps, "Number of steps to simulate";
Quentin Aristote's avatar
Quentin Aristote committed
413
414
415
416
417
418
419
420
421
422
     "-rom", Arg.Set_string rom_directory, "Location of the ROM files. By defau"
                                           ^ "lt, set to './' . The path of the"
                                           ^ "directory must contain a / at its"
                                           ^ "end. \n       There must be one <"
                                           ^ "var>.rom file for each variable <"
                                           ^ "var> that accesses the ROM.\n    "
                                           ^ "Each file should be a binary file"
                                           ^ ", that is a text file where chara"
                                           ^ "cter n is the ASCII character cor"
                                           ^ "responding encoded by the byte RO"
Quentin Aristote's avatar
Quentin Aristote committed
423
                                           ^ "M[n]ROM[n+1]...ROM[n+7].";
Quentin Aristote's avatar
Quentin Aristote committed
424
     "-time", Arg.Int (fun t -> cycle_duration := float_of_int t /. 1000.),
Quentin Aristote's avatar
Quentin Aristote committed
425
     "Minimum time in millisecondes each cycle has to take, set to 0 by default."]
426
427
428
429
430
    compile
    "" 
;;

main ()