package MlFront_Manip

  1. Overview
  2. Docs

Source file ParseBc.ml

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
# 1 "src/MlFront_Manip/ParseBc51.ml"
let parse_bc ~verbose ?caml_CODE ?caml_DATA ?caml_DBUG ?caml_SYMB ?caml_PRIM
    ?caml_CRCS ic =
  (* Read Table of Contents *)
  let section_table = Bytesections.read_toc ic in
  let all_sections = Bytesections.all section_table in
  if verbose then begin
    prerr_endline "Bytecode Table of Contents";
    prerr_endline "--------------------------";
    List.iter
      (fun Bytesections.{ name; pos; len } ->
        Format.eprintf "(section,pos,len) = (%s,%d,%d)@."
          (Bytesections.Name.to_string name)
          pos len)
      all_sections
  end;

  (* Parse *)
  let find name' =
    List.find_map
      (fun Bytesections.{ name; pos = _; len = _ } ->
        if Bytesections.Name.to_string name = name' then Some name else None)
      all_sections
  in
  let as_string name opt =
    match opt with
    | None -> ()
    | Some f ->
    match find name with
    | None ->
        failwith
          (Printf.sprintf
             "The section %s was requested but was not present in the bytecode \
              table of contents"
             name)
    | Some name' -> (
        let x =
          try Some (Bytesections.read_section_string section_table ic name')
          with Invalid_argument msg ->
            failwith (Format.asprintf "Failed to read section %s: %s" name msg)
        in
        match x with None -> () | Some x' -> f x')
  in
  let as_string_skip_if_no_mem name opt =
    match opt with
    | None -> ()
    | Some f ->
    match find name with
    | None ->
        failwith
          (Printf.sprintf
             "The section %s was requested but was not present in the bytecode \
              table of contents"
             name)
    | Some name' -> (
        let x =
          try
            Some (Bytesections.read_section_string section_table ic name')
          with
          | Invalid_argument msg when msg = "Bytes.create" ->
              (* [Bytes.create] is running out of memory limits (16MB strings
                 on 32-bit machine). *)
              None
          | Invalid_argument msg ->
              failwith
                (Format.asprintf "Failed to read section %s: %s" name msg)
        in
        match x with None -> f None | Some x' -> f (Some x'))
  in
  let as_struct name opt =
    match opt with
    | None -> ()
    | Some f ->
    match find name with
    | None ->
        failwith
          (Printf.sprintf
             "The section %s was requested but was not present in the bytecode \
              table of contents"
             name)
    | Some name -> f (Bytesections.read_section_struct section_table ic name)
  in
  as_string "CODE" caml_CODE;
  as_string "DATA" caml_DATA;
  as_string_skip_if_no_mem "DBUG" caml_DBUG;
  as_struct "SYMB" caml_SYMB;
  as_string "PRIM" caml_PRIM;
  as_struct "CRCS" caml_CRCS