raw_spacetime_lib refactor + related fixes (#1477)

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