diff options
Diffstat (limited to 'otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml')
-rw-r--r-- | otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml | 91 |
1 files changed, 30 insertions, 61 deletions
diff --git a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml index 2592d39329..98edc53545 100644 --- a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml +++ b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml @@ -146,8 +146,7 @@ module Trace = struct (* This function unmarshals into malloc blocks, which mean that we obtain a straightforward means of writing [compare] on [node]s. *) external unmarshal : in_channel -> 'a - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_unmarshal_trie" + = "caml_spacetime_unmarshal_trie" let unmarshal in_channel = let trace = unmarshal in_channel in @@ -156,15 +155,11 @@ module Trace = struct else Some ((Obj.magic trace) : node) - let node_is_null (node : node) = - ((Obj.magic node) : unit) == () - let foreign_node_is_null (node : foreign_node) = ((Obj.magic node) : unit) == () external node_num_header_words : unit -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_node_num_header_words" "noalloc" + = "caml_spacetime_node_num_header_words" [@@noalloc] let num_header_words = lazy (node_num_header_words ()) @@ -186,16 +181,14 @@ module Trace = struct | _ -> assert false external annotation : ocaml_node -> int -> Annotation.t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_allocation_point_annotation" - "noalloc" + = "caml_spacetime_ocaml_allocation_point_annotation" + [@@noalloc] let annotation t = annotation t.node t.offset external count : ocaml_node -> int -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_allocation_point_count" - "noalloc" + = "caml_spacetime_ocaml_allocation_point_count" + [@@noalloc] let num_words_including_headers t = count t.node t.offset end @@ -214,15 +207,13 @@ module Trace = struct | _ -> assert false external callee_node : ocaml_node -> int -> 'target - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_direct_call_point_callee_node" + = "caml_spacetime_ocaml_direct_call_point_callee_node" let callee_node (type target) (t : target t) : target = callee_node t.node t.offset external call_count : ocaml_node -> int -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_direct_call_point_call_count" + = "caml_spacetime_ocaml_direct_call_point_call_count" let call_count t = if Shape_table.call_counts t.shape_table then @@ -252,30 +243,26 @@ module Trace = struct (* CR-soon mshinwell: maybe rename ...c_node_call_site -> c_node_pc, since it isn't a call site in this case. *) external callee : foreign_node -> Function_entry_point.t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_call_site" + = "caml_spacetime_c_node_call_site" let callee t = callee t.node (* This can return a node satisfying "is_null" in the case of an uninitialised tail call point. See the comment in the C code. *) external callee_node : foreign_node -> node - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_callee_node" "noalloc" + = "caml_spacetime_c_node_callee_node" [@@noalloc] let callee_node t = callee_node t.node external call_count : foreign_node -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_call_count" + = "caml_spacetime_c_node_call_count" let call_count t = if t.call_counts then Some (call_count t.node) else None external next : foreign_node -> foreign_node - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_next" "noalloc" + = "caml_spacetime_c_node_next" [@@noalloc] let next t = let next = { t with node = next t.node; } in @@ -284,9 +271,8 @@ module Trace = struct end external callees : ocaml_node -> int -> foreign_node - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_indirect_call_point_callees" - "noalloc" + = "caml_spacetime_ocaml_indirect_call_point_callees" + [@@noalloc] let callees t = let callees = @@ -314,13 +300,12 @@ module Trace = struct | Indirect_call of Indirect_call_point.t external classify_direct_call_point : ocaml_node -> int -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_classify_direct_call_point" - "noalloc" + = "caml_spacetime_classify_direct_call_point" + [@@noalloc] let classify t = match t.part_of_shape with - | Shape_table.Direct_call callee -> + | Shape_table.Direct_call _callee -> let direct_call_point = match classify_direct_call_point t.node t.offset with | 0 -> @@ -381,16 +366,13 @@ module Trace = struct type t = ocaml_node external function_identifier : t -> Function_identifier.t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_function_identifier" + = "caml_spacetime_ocaml_function_identifier" external next_in_tail_call_chain : t -> t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_ocaml_tail_chain" "noalloc" + = "caml_spacetime_ocaml_tail_chain" [@@noalloc] external compare : t -> t -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_compare_node" "noalloc" + = "caml_spacetime_compare_node" [@@noalloc] let fields t ~shape_table = let id = function_identifier t in @@ -415,8 +397,7 @@ module Trace = struct type t = foreign_node external compare : t -> t -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_compare_node" "noalloc" + = "caml_spacetime_compare_node" [@@noalloc] let fields t = if foreign_node_is_null t then None @@ -428,29 +409,24 @@ module Trace = struct external program_counter : t -> Program_counter.Foreign.t (* This is not a mistake; the same C function works. *) - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_call_site" + = "caml_spacetime_c_node_call_site" external annotation : t -> Annotation.t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_profinfo" "noalloc" + = "caml_spacetime_c_node_profinfo" [@@noalloc] external num_words_including_headers : t -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_allocation_count" "noalloc" + = "caml_spacetime_c_node_allocation_count" [@@noalloc] end module Call_point = struct type t = foreign_node external call_site : t -> Program_counter.Foreign.t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_call_site" + = "caml_spacetime_c_node_call_site" (* May return a null node. See comment above and the C code. *) external callee_node : t -> node - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_callee_node" "noalloc" + = "caml_spacetime_c_node_callee_node" [@@noalloc] end module Field = struct @@ -461,16 +437,14 @@ module Trace = struct | Call of Call_point.t external is_call : t -> bool - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_is_call" "noalloc" + = "caml_spacetime_c_node_is_call" [@@noalloc] let classify t = if is_call t then Call t else Allocation t external next : t -> t - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_c_node_next" "noalloc" + = "caml_spacetime_c_node_next" [@@noalloc] let next t = let next = next t in @@ -484,8 +458,7 @@ module Trace = struct type t = node external compare : t -> t -> int - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_compare_node" "noalloc" + = "caml_spacetime_compare_node" [@@noalloc] end include T @@ -494,10 +467,8 @@ module Trace = struct | OCaml of OCaml.Node.t | Foreign of Foreign.Node.t - (* CR-soon lwhite: These functions should work in bytecode *) external is_ocaml_node : t -> bool - = "caml_spacetime_only_works_for_native_code" - "caml_spacetime_is_ocaml_node" "noalloc" + = "caml_spacetime_is_ocaml_node" [@@noalloc] let classify t = if is_ocaml_node t then OCaml ((Obj.magic t) : ocaml_node) @@ -601,8 +572,6 @@ module Heap_snapshot = struct call_counts : bool; } - let pathname_suffix_trace = "trace" - (* The order of these constructors must match the C code. *) type what_comes_next = | Snapshot |