Merge branch 'sail2' into rmem_interpreter

1 files changed, 53 insertions, 26 deletions

diff --git a/src/elf_loader.ml b/src/elf_loader.ml
index c6fb0589..abe935b2 100644
--- a/src/elf_loader.ml
+++ b/src/elf_loader.ml
@@ -47,6 +47,10 @@ let opt_elf_threads = ref 1
 let opt_elf_entry = ref Big_int.zero
 let opt_elf_tohost = ref Big_int.zero
 
+(* the type of elf last loaded *)
+type elf_class = ELF_Class_64 | ELF_Class_32
+let opt_elf_class = ref ELF_Class_64 (* default *)
+
 type word8 = int
 
 let escape_char c =
@@ -66,14 +70,16 @@ let break n xs =
     | (_ :: _ as xs) -> helper ([Lem_list.take n xs] @ acc) (Lem_list.drop n xs)
   in helper [] xs
 
-let print_segment seg =
-  let bs = seg.Elf_interpreted_segment.elf64_segment_body in
+let print_segment bs =
   prerr_endline "0011 2233 4455 6677 8899 aabb ccdd eeff 0123456789abcdef";
   List.iter (fun bs -> prerr_endline (hex_line bs)) (break 16 (Byte_sequence.char_list_of_byte_sequence bs))
 
+type elf_segs =
+  | ELF64 of Elf_interpreted_segment.elf64_interpreted_segment list
+  | ELF32 of Elf_interpreted_segment.elf32_interpreted_segment list
+
 let read name =
   let info = Sail_interface.populate_and_obtain_global_symbol_init_info name in
-
   prerr_endline "Elf read:";
   let (elf_file, elf_epi, symbol_map) =
     begin match info with
@@ -87,20 +93,18 @@ let read name =
        (elf_file, elf_epi, symbol_map)
     end
   in
-
   prerr_endline "\nElf segments:";
+
+  (* remove all the auto generated segments (they contain only 0s) *)
+  let prune_segments segs =
+    Lem_list.mapMaybe (fun (seg, prov) -> if prov = Elf_file.FromELF then Some seg else None) segs in
   let (segments, e_entry, e_machine) =
     begin match elf_epi, elf_file with
-    | (Sail_interface.ELF_Class_32 _, _) -> failwith "cannot handle ELF_Class_32"
-    | (_, Elf_file.ELF_File_32 _)  -> failwith "cannot handle ELF_File_32"
-    | (Sail_interface.ELF_Class_64 (segments, e_entry, e_machine), Elf_file.ELF_File_64 f1) ->
-       (* remove all the auto generated segments (they contain only 0s) *)
-       let segments =
-         Lem_list.mapMaybe
-           (fun (seg, prov) -> if prov = Elf_file.FromELF then Some seg else None)
-           segments
-       in
-       (segments, e_entry, e_machine)
+    | (Sail_interface.ELF_Class_32 (segments, e_entry, e_machine), Elf_file.ELF_File_32 _) ->
+          (ELF32 (prune_segments segments), e_entry, e_machine)
+    | (Sail_interface.ELF_Class_64 (segments, e_entry, e_machine), Elf_file.ELF_File_64 _) ->
+          (ELF64 (prune_segments segments), e_entry, e_machine)
+    | (_, _) -> failwith "cannot handle ELF file"
     end
   in
   (segments, e_entry, symbol_map)
@@ -120,24 +124,20 @@ let write_file chan paddr i byte =
   output_string chan (Big_int.to_string (Big_int.add paddr (Big_int.of_int i)) ^ "\n");
   output_string chan (string_of_int byte ^ "\n")
 
-let load_segment ?writer:(writer=write_sail_lib) seg =
-  let open Elf_interpreted_segment in
-  let bs = seg.elf64_segment_body in
-  let paddr = seg.elf64_segment_paddr in
-  let base = seg.elf64_segment_base in
-  let offset = seg.elf64_segment_offset in
-  let size = seg.elf64_segment_size in
-  let memsz = seg.elf64_segment_memsz in
+let print_seg_info offset base paddr size memsz =
   prerr_endline "\nLoading Segment";
   prerr_endline ("Segment offset: " ^ (Printf.sprintf "0x%Lx" (Big_int.to_int64 offset)));
   prerr_endline ("Segment base address: " ^ (Big_int.to_string base));
   (* NB don't attempt to convert paddr to int64 because on MIPS it is quite likely to exceed signed
-     64-bit range e.g. addresses beginning 0x9.... Really need to_uint64 or to_string_hex but lem 
+     64-bit range e.g. addresses beginning 0x9.... Really need to_uint64 or to_string_hex but lem
      doesn't have them. *)
   prerr_endline ("Segment physical address: " ^ (Printf.sprintf "0x%Lx" (Big_int.to_int64 paddr)));
   prerr_endline ("Segment size: " ^  (Printf.sprintf "0x%Lx" (Big_int.to_int64 size)));
-  prerr_endline ("Segment memsz: " ^ (Printf.sprintf "0x%Lx" (Big_int.to_int64 memsz)));
-  print_segment seg;
+  prerr_endline ("Segment memsz: " ^ (Printf.sprintf "0x%Lx" (Big_int.to_int64 memsz)))
+
+let load_segment ?writer:(writer=write_sail_lib) bs paddr base offset size memsz =
+  print_seg_info offset base paddr size memsz;
+  print_segment bs;
   List.iteri (writer paddr) (List.rev_map int_of_char (List.rev (Byte_sequence.char_list_of_byte_sequence bs)));
   write_mem_zeros (Big_int.add paddr size) (Big_int.sub memsz size)
 
@@ -147,7 +147,32 @@ let load_elf ?writer:(writer=write_sail_lib) name =
   (if List.mem_assoc "tohost" symbol_map then
      let (_, _, tohost_addr, _, _) = List.assoc "tohost" symbol_map in
      opt_elf_tohost := tohost_addr);
-  List.iter (load_segment ~writer:writer) segments
+  (match segments with
+     | ELF64 segs ->
+           List.iter (fun seg ->
+                      let open Elf_interpreted_segment in
+                      let bs = seg.elf64_segment_body in
+                      let paddr = seg.elf64_segment_paddr in
+                      let base = seg.elf64_segment_base in
+                      let offset = seg.elf64_segment_offset in
+                      let size = seg.elf64_segment_size in
+                      let memsz = seg.elf64_segment_memsz in
+                      load_segment ~writer:writer bs paddr base offset size memsz)
+                     segs;
+           opt_elf_class := ELF_Class_64
+     | ELF32 segs ->
+           List.iter (fun seg ->
+                      let open Elf_interpreted_segment in
+                      let bs = seg.elf32_segment_body in
+                      let paddr = seg.elf32_segment_paddr in
+                      let base = seg.elf32_segment_base in
+                      let offset = seg.elf32_segment_offset in
+                      let size = seg.elf32_segment_size in
+                      let memsz = seg.elf32_segment_memsz in
+                      load_segment ~writer:writer bs paddr base offset size memsz)
+                     segs;
+           opt_elf_class := ELF_Class_32
+  )
 
 let load_binary ?writer:(writer=write_sail_lib) addr name =
   let f = open_in_bin name in
@@ -172,3 +197,5 @@ let load_binary ?writer:(writer=write_sail_lib) addr name =
 let elf_entry () = !opt_elf_entry
 (* Used by RISCV sail model test harness for exiting test *)
 let elf_tohost () = !opt_elf_tohost
+(* Used to check last loaded elf class. *)
+let elf_class () = !opt_elf_class