aboutsummaryrefslogtreecommitdiff
path: root/ocaml_emulator/platform_impl.ml
blob: 39de43776a31c8bd3a16f7ac8032a071bb963b6d (plain)
1
2
3
4
5
6
7
8
9
10
11
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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
(* architecture *)

type arch =
  | RV32
  | RV64

let str_of_arch = function
  | RV32 -> "RV32"
  | RV64 -> "RV64"

(* int->byte converters in little-endian order *)

let uint32_to_bytes u = let open Int32 in
 List.map to_int
  [ logand u 0xffl;
    logand (shift_right u 8) 0xffl;
    logand (shift_right u 16) 0xffl;
    logand (shift_right u 24) 0xffl;
  ]

let uint64_to_bytes u = let open Int64 in
 List.map to_int
  [ logand u 0xffL;
    logand (shift_right u 8) 0xffL;
    logand (shift_right u 16) 0xffL;
    logand (shift_right u 24) 0xffL;
    logand (shift_right u 32) 0xffL;
    logand (shift_right u 40) 0xffL;
    logand (shift_right u 48) 0xffL;
    logand (shift_right u 56) 0xffL;
  ]

(* reset vector for the rom *)

let reset_vec_size = 8l;;

let reset_vec_int arch start_pc = [
  0x297l;                                                 (* auipc  t0, 0x0      *)
  (let open Int32 in
   add 0x28593l (shift_left (mul reset_vec_size 4l) 20)); (* addi   a1, t0, ofs(dtb) *)
  0xf1402573l;                                            (* csrr   a0, mhartid  *)
  (match arch with
     | RV32 -> 0x0182a283l                                (* lw     t0, 24(t0)   *)
     | RV64 -> 0x0182b283l);                              (* ld     t0, 24(t0)   *)
  0x28067l;                                               (* jr     t0           *)
  0x0l;
  (let open Int64 in to_int32 (logand start_pc 0xffffffffL));
  (let open Int64 in to_int32 (shift_right_logical start_pc 32));
]

(* address map *)

let dram_base  = 0x80000000L;;  (* Spike::DRAM_BASE *)
let clint_base = 0x02000000L;;  (* Spike::CLINT_BASE *)
let clint_size = 0x000c0000L;;  (* Spike::CLINT_SIZE *)
let rom_base   = 0x00001000L;;  (* Spike::DEFAULT_RSTVEC *)

let dram_size_ref = ref (Int64.(shift_left 64L 20))

type mem_region = {
    addr : Int64.t;
    size : Int64.t
}

(* dts from spike *)
let spike_dts isa_spec mmu_spec cpu_hz insns_per_rtc_tick mems =
    "/dts-v1/;\n"
  ^ "\n"
  ^ "/ {\n"
  ^ "  #address-cells = <2>;\n"
  ^ "  #size-cells = <2>;\n"
  ^ "  compatible = \"ucbbar,spike-bare-dev\";\n"
  ^ "  model = \"ucbbar,spike-bare\";\n"
  ^ "  cpus {\n"
  ^ "    #address-cells = <1>;\n"
  ^ "    #size-cells = <0>;\n"
  ^ "    timebase-frequency = <" ^ string_of_int (cpu_hz/insns_per_rtc_tick) ^ ">;\n"
  ^ "    CPU0: cpu@0 {\n"
  ^ "      device_type = \"cpu\";\n"
  ^ "      reg = <0>;\n"
  ^ "      status = \"okay\";\n"
  ^ "      compatible = \"riscv\";\n"
  ^ "      riscv,isa = \"" ^ isa_spec ^ "\";\n"
  ^ "      mmu-type = \"riscv," ^ mmu_spec ^ "\";\n"
  ^ "      clock-frequency = <" ^ string_of_int cpu_hz ^ ">;\n"
  ^ "      CPU0_intc: interrupt-controller {\n"
  ^ "        #interrupt-cells = <1>;\n"
  ^ "        interrupt-controller;\n"
  ^ "        compatible = \"riscv,cpu-intc\";\n"
  ^ "      };\n"
  ^ "    };\n"
  ^ "  };\n"
  ^ (List.fold_left (^) ""
       (List.map (fun m ->
         "  memory@" ^ Printf.sprintf "%Lx" m.addr ^ " {\n"
         ^ "    device_type = \"memory\";\n"
         ^ "    reg = <0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical m.addr 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand m.addr 0xffffffffL)
         ^           " 0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical m.size 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand m.size 0xffffffffL) ^ ">;\n"
         ^ "  };\n") mems))
  ^ "  soc {\n"
  ^ "    #address-cells = <2>;\n"
  ^ "    #size-cells = <2>;\n"
  ^ "    compatible = \"ucbbar,spike-bare-soc\", \"simple-bus\";\n"
  ^ "    ranges;\n"
  ^ "    clint@" ^ Printf.sprintf "%Lx" clint_base ^ " {\n"
  ^ "      compatible = \"riscv,clint0\";\n"
  ^ "      interrupts-extended = <&CPU0_intc 3 &CPU0_intc 7 >;\n"
  ^ "      reg = <0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical clint_base 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand clint_base 0xffffffffL)
  ^             " 0x" ^ Printf.sprintf "%Lx" Int64.(shift_right_logical clint_size 32) ^ " 0x" ^ Printf.sprintf "%Lx" Int64.(logand clint_size 0xffffffffL) ^ ">;\n"
  ^ "    };\n"
  ^ "  };\n"
  ^ "  htif {\n"
  ^ "    compatible = \"ucb,htif0\";\n"
  ^ "  };\n"
  ^ "};\n"

let cpu_hz = 1000000000;;
let insns_per_tick = 100;;

let make_mems () = [{ addr = dram_base;
                      size = !dram_size_ref }];;

let make_dts arch =
  let isa, mmu = match arch with
      | RV64 -> "rv64imac", "sv39"
      | RV32 -> "rv32imac", "sv32" in
  spike_dts isa mmu cpu_hz insns_per_tick (make_mems ());;

let bytes_to_string bytes =
  String.init (List.length bytes) (fun i -> Char.chr (List.nth bytes i))

let dtc_path = ref "/usr/bin/dtc"

let set_dtc path =
  try let st = Unix.stat path in
      if st.Unix.st_kind = Unix.S_REG && st.Unix.st_perm != 0
      then dtc_path := path
      else ( Printf.eprintf "%s doesn't seem like a valid executable.\n%!" path;
             exit 1)
  with Unix.Unix_error (e, _, _) ->
    ( Printf.eprintf "Error accessing %s: %s\n%!" path (Unix.error_message e);
      exit 1)

let set_dram_size mb =
  dram_size_ref := Int64.(shift_left (Int64.of_int mb) 20)

let make_dtb dts = (* Call the dtc compiler, assumed to be at /usr/bin/dtc *)
  try
    let cmd = Printf.sprintf "%s -I dts" !dtc_path in
    let (cfrom, cto, cerr) =
      Unix.open_process_full cmd [||]
    in (
      output_string cto dts;
      (* print_endline " sent dts to dtc ..."; *)
      close_out cto;
      (* simple and stupid for now *)
      let rec accum_bytes cin acc =
        match (
          try  Some (input_byte cin)
          with End_of_file -> None
        ) with
          | Some b -> accum_bytes cin (b :: acc)
          | None   -> List.rev acc
      in
      (* let _ = print_endline " accumulating dtb ..." in *)
      let dtb  = accum_bytes cfrom [] in
      (* let _ = print_endline " accumulating emsg ..." in *)
      let emsg = bytes_to_string (accum_bytes cerr []) in
      match Unix.close_process_full (cfrom, cto, cerr) with
        | Unix.WEXITED 0 -> dtb
        | _ -> (Printf.printf "%s\n%!" ("Error executing dtc: " ^ emsg);
                exit 1)
    )
  with Unix.Unix_error (e, fn, _) ->
    (Printf.printf "%s\n" ("Error executing dtc: " ^ fn ^ ": " ^ Unix.error_message e);
     exit 1)

(* Terminal I/O *)

let term_write char =
  ignore (Unix.write_substring Unix.stderr (String.make 1 char) 0 1)

let rec term_read () =
  let buf = Bytes.make 1 '\000' in
  let nbytes = Unix.read Unix.stdin buf 0 1 in
  (* todo: handle nbytes == 0 *)
  Bytes.get buf 0

(* Platform diagnostics *)

let show_bytes s =
  output_string stdout s

let dump_dts arch = show_bytes (make_dts arch)
let dump_dtb arch = show_bytes (bytes_to_string (make_dtb (make_dts arch)))

(*
let save_string_to_file s fname =
  let out = open_out fname in
  output_string out s;
  close_out out;;

 *)