diff options
Diffstat (limited to 'otherlibs')
| -rw-r--r-- | otherlibs/raw_spacetime_lib/Makefile | 66 | ||||
| -rw-r--r-- | otherlibs/raw_spacetime_lib/raw_spacetime_lib.ml | 91 | ||||
| -rw-r--r-- | otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli | 1 | ||||
| -rw-r--r-- | otherlibs/raw_spacetime_lib/spacetime_offline.c | 251 |
4 files changed, 291 insertions, 118 deletions
diff --git a/otherlibs/raw_spacetime_lib/Makefile b/otherlibs/raw_spacetime_lib/Makefile index 4b40cabb68..5ba21859b6 100644 --- a/otherlibs/raw_spacetime_lib/Makefile +++ b/otherlibs/raw_spacetime_lib/Makefile @@ -15,67 +15,19 @@ # Makefile for Raw_spacetime_lib -ROOTDIR=../.. -include $(ROOTDIR)/config/Makefile - -CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun -CAMLC=$(CAMLRUN) $(ROOTDIR)/ocamlc -nostdlib -I $(ROOTDIR)/stdlib -CAMLOPT=$(CAMLRUN) $(ROOTDIR)/ocamlopt -nostdlib \ - -I $(ROOTDIR)/stdlib - -# The remainder of this file could probably be simplified by including -# ../Makefile. - LIBNAME=raw_spacetime_lib +COBJS=spacetime_offline.$(O) CAMLOBJS=raw_spacetime_lib.cmo -COMPFLAGS=-w +33..39 -warn-error A -bin-annot -g -safe-string $(EXTRACAMLFLAGS) - -CMIFILES=$(CAMLOBJS:.cmo=.cmi) -CAMLOBJS_NAT=$(CAMLOBJS:.cmo=.cmx) - -all: $(LIBNAME).cma $(CMIFILES) - -allopt: $(LIBNAME).cmxa $(LIBNAME).$(CMXS) $(CMIFILES) - -$(LIBNAME).cma: $(CAMLOBJS) - $(CAMLC) -a -o $(LIBNAME).cma -linkall $(CAMLOBJS) - -$(LIBNAME).cmxa: $(CAMLOBJS_NAT) - $(CAMLOPT) -a -o $(LIBNAME).cmxa -linkall $(CAMLOBJS_NAT) - -$(LIBNAME).cmxs: $(LIBNAME).cmxa - $(CAMLOPT) -shared -o $(LIBNAME).cmxs -I . $(LIBNAME).cmxa - -INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR) - -install:: - cp $(LIBNAME).cma $(CMIFILES) $(CMIFILES:.cmi=.mli) $(INSTALL_LIBDIR) - -installopt: - cp $(CAMLOBJS_NAT) $(LIBNAME).cmxa $(LIBNAME).$(A) $(INSTALL_LIBDIR)/ - if test -f $(LIBNAME).cmxs; then \ - cp $(LIBNAME).cmxs $(INSTALL_LIBDIR)/; \ - fi - -partialclean: - rm -f *.cm* - -clean:: partialclean - rm -f *.a *.o - -.SUFFIXES: .ml .mli .cmi .cmo .cmx - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) $< - -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) $< +include ../Makefile +.PHONY: depend depend: - $(CAMLRUN) $(ROOTDIR)/tools/ocamldep *.mli *.ml > .depend +ifeq "$(TOOLCHAIN)" "msvc" + $(error Dependencies cannot be regenerated using the MSVC ports) +else + $(CC) -MM $(CPPFLAGS) *.c | sed -e 's/\.o/.$$(O)/g' > .depend + $(CAMLRUN) $(ROOTDIR)/tools/ocamldep -slash *.mli *.ml >> .depend +endif include .depend 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 diff --git a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli index 051057dde4..6bdffffe96 100644 --- a/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli +++ b/otherlibs/raw_spacetime_lib/raw_spacetime_lib.mli @@ -324,6 +324,7 @@ module Heap_snapshot : sig val num_words_including_headers : t -> int val next : t -> t option end + (** Total allocations across *all threads*. *) (* CR-someday mshinwell: change the relevant variables to be thread-local *) val total_allocations : t -> Total_allocation.t option diff --git a/otherlibs/raw_spacetime_lib/spacetime_offline.c b/otherlibs/raw_spacetime_lib/spacetime_offline.c new file mode 100644 index 0000000000..fa93e5da99 --- /dev/null +++ b/otherlibs/raw_spacetime_lib/spacetime_offline.c @@ -0,0 +1,251 @@ +/**************************************************************************/ +/* */ +/* OCaml */ +/* */ +/* Mark Shinwell and Leo White, Jane Street Europe */ +/* */ +/* Copyright 2013--2016, Jane Street Group, LLC */ +/* */ +/* All rights reserved. This file is distributed under the terms of */ +/* the GNU Lesser General Public License version 2.1, with the */ +/* special exception on linking described in the file LICENSE. */ +/* */ +/**************************************************************************/ + +#define CAML_INTERNALS + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <limits.h> +#include <math.h> + +#include "caml/alloc.h" +#include "caml/config.h" +#include "caml/fail.h" +#include "caml/gc.h" +#include "caml/intext.h" +#include "caml/major_gc.h" +#include "caml/memory.h" +#include "caml/minor_gc.h" +#include "caml/misc.h" +#include "caml/mlvalues.h" +#include "caml/roots.h" +#include "caml/signals.h" +#include "caml/stack.h" +#include "caml/sys.h" +#include "caml/spacetime.h" + +#include "caml/s.h" + +#define SPACETIME_PROFINFO_WIDTH 26 +#define Spacetime_profinfo_hd(hd) \ + (Gen_profinfo_hd(SPACETIME_PROFINFO_WIDTH, hd)) + +#ifdef ARCH_SIXTYFOUR + +/* CR-someday lwhite: The following two definitions are copied from spacetime.c + because they are needed here, but must be inlined in spacetime.c + for performance. Perhaps a macro or "static inline" would be + more appropriate. */ + +c_node* caml_spacetime_offline_c_node_of_stored_pointer_not_null + (value node_stored) +{ + CAMLassert(Is_c_node(node_stored)); + return (c_node*) Hp_val(node_stored); +} + +c_node_type caml_spacetime_offline_classify_c_node(c_node* node) +{ + return (node->pc & 2) ? CALL : ALLOCATION; +} + +CAMLprim value caml_spacetime_compare_node( + value node1, value node2) +{ + CAMLassert(!Is_in_value_area(node1)); + CAMLassert(!Is_in_value_area(node2)); + + if (node1 == node2) { + return Val_long(0); + } + if (node1 < node2) { + return Val_long(-1); + } + return Val_long(1); +} + +CAMLprim value caml_spacetime_unmarshal_trie (value v_channel) +{ + return caml_input_value_to_outside_heap(v_channel); +} + +CAMLprim value caml_spacetime_node_num_header_words(value unit) +{ + unit = Val_unit; + return Val_long(Node_num_header_words); +} + +CAMLprim value caml_spacetime_is_ocaml_node(value node) +{ + CAMLassert(Is_ocaml_node(node) || Is_c_node(node)); + return Val_bool(Is_ocaml_node(node)); +} + +CAMLprim value caml_spacetime_ocaml_function_identifier(value node) +{ + CAMLassert(Is_ocaml_node(node)); + return caml_copy_int64((uint64_t) Decode_node_pc(Node_pc(node))); +} + +CAMLprim value caml_spacetime_ocaml_tail_chain(value node) +{ + CAMLassert(Is_ocaml_node(node)); + return Tail_link(node); +} + +CAMLprim value caml_spacetime_classify_direct_call_point + (value node, value offset) +{ + uintnat field; + value callee_node; + + CAMLassert(Is_ocaml_node(node)); + + field = Long_val(offset); + + callee_node = Direct_callee_node(node, field); + if (!Is_block(callee_node)) { + /* An unused call point (may be a tail call point). */ + return Val_long(0); + } else if (Is_ocaml_node(callee_node)) { + return Val_long(1); /* direct call point to OCaml code */ + } else { + return Val_long(2); /* direct call point to non-OCaml code */ + } +} + +CAMLprim value caml_spacetime_ocaml_allocation_point_annotation + (value node, value offset) +{ + uintnat profinfo_shifted; + profinfo_shifted = (uintnat) Alloc_point_profinfo(node, Long_val(offset)); + return Val_long(Spacetime_profinfo_hd(profinfo_shifted)); +} + +CAMLprim value caml_spacetime_ocaml_allocation_point_count + (value node, value offset) +{ + value count = Alloc_point_count(node, Long_val(offset)); + CAMLassert(!Is_block(count)); + return count; +} + +CAMLprim value caml_spacetime_ocaml_direct_call_point_callee_node + (value node, value offset) +{ + return Direct_callee_node(node, Long_val(offset)); +} + +CAMLprim value caml_spacetime_ocaml_direct_call_point_call_count +(value node, value offset) +{ + return Direct_call_count(node, Long_val(offset)); +} + +CAMLprim value caml_spacetime_ocaml_indirect_call_point_callees + (value node, value offset) +{ + value callees = Indirect_pc_linked_list(node, Long_val(offset)); + CAMLassert(Is_block(callees)); + CAMLassert(Is_c_node(callees)); + return callees; +} + +CAMLprim value caml_spacetime_c_node_is_call(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + switch (caml_spacetime_offline_classify_c_node(c_node)) { + case CALL: return Val_true; + case ALLOCATION: return Val_false; + } + CAMLassert(0); + return Val_unit; /* silence compiler warning */ +} + +CAMLprim value caml_spacetime_c_node_next(value node) +{ + c_node* c_node; + + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + CAMLassert(c_node->next == Val_unit || Is_c_node(c_node->next)); + return c_node->next; +} + +CAMLprim value caml_spacetime_c_node_call_site(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + return caml_copy_int64((uint64_t) Decode_c_node_pc(c_node->pc)); +} + +CAMLprim value caml_spacetime_c_node_callee_node(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL); + /* This might be an uninitialised tail call point: for example if an OCaml + callee was indirectly called but the callee wasn't instrumented (e.g. a + leaf function that doesn't allocate). */ + if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) { + return Val_unit; + } + return c_node->data.call.callee_node; +} + +CAMLprim value caml_spacetime_c_node_call_count(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == CALL); + if (Is_tail_caller_node_encoded(c_node->data.call.callee_node)) { + return Val_long(0); + } + return c_node->data.call.call_count; +} + +CAMLprim value caml_spacetime_c_node_profinfo(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION); + CAMLassert(!Is_block(c_node->data.allocation.profinfo)); + return Val_long(Spacetime_profinfo_hd(c_node->data.allocation.profinfo)); +} + +CAMLprim value caml_spacetime_c_node_allocation_count(value node) +{ + c_node* c_node; + CAMLassert(node != (value) NULL); + CAMLassert(Is_c_node(node)); + c_node = caml_spacetime_offline_c_node_of_stored_pointer_not_null(node); + CAMLassert(caml_spacetime_offline_classify_c_node(c_node) == ALLOCATION); + CAMLassert(!Is_block(c_node->data.allocation.count)); + return c_node->data.allocation.count; +} + +#endif |