Merge pull request #156 from anuragsoni/conditional-compilation-for-5…

…00-4-14

Get core compiling with OCaml 5.0

core/src/core_pervasives.ml

@@ -18,3 +18,10 @@ external raise : exn -> 'a = "%reraise"
 let __FUNCTION__ = "<__FUNCTION__ not supported before OCaml 4.12>"
 
 [%%endif]
+
+[%%if ocaml_version >= (5, 0, 0)]
+
+external ( & ) : bool -> bool -> bool = "%sequand"
+external ( or ) : bool -> bool -> bool = "%sequor"
+
+[%%endif]

core/src/ephemeron.ml

@@ -1,29 +1 @@
-open! Import
-open Std_internal
-module Ephemeron = Caml.Ephemeron.K1
-
-type ('a, 'b) t = ('a Heap_block.t, 'b Heap_block.t) Ephemeron.t
-
-let create = Ephemeron.create
-
-let set_key t = function
-  | None -> Ephemeron.unset_key t
-  | Some v -> Ephemeron.set_key t v
-;;
-
-let get_key = Ephemeron.get_key
-
-let set_data t = function
-  | None -> Ephemeron.unset_data t
-  | Some v -> Ephemeron.set_data t v
-;;
-
-let get_data = Ephemeron.get_data
-let is_key_some t = Ephemeron.check_key t
-let is_key_none t = not (is_key_some t)
-let is_data_some t = Ephemeron.check_data t
-let is_data_none t = not (is_data_some t)
-
-let sexp_of_t sexp_of_a sexp_of_b t =
-  [%sexp_of: a Heap_block.t option * b Heap_block.t option] (get_key t, get_data t)
-;;
+include Caml.Ephemeron

core/src/ephemeron.mli

@@ -1,26 +1 @@
-(** An ephemeron is a pair of pointers, one to a "key" and one to "data".
-
-    The key pointer is a weak pointer: the garbage collector doesn't follow it when
-    determining liveness. The garbage collector follows an ephemeron's data pointer iff
-    the key is alive. If the garbage collector nulls an ephemeron's weak pointer then it
-    also nulls the data pointer. Ephemerons are more powerful than weak pointers because
-    they express conjunction of liveness -- the data in an ephemeron is live iff both the
-    key {e and} the ephemeron are live. See "Ephemerons: A New Finalization Mechanism",
-    Barry Hayes 1997.
-
-    This module is like the OCaml standard library module [Ephemerons.K1], except that it
-    requires that the keys and data are heap blocks. *)
-
-open! Import
-
-type ('a, 'b) t [@@deriving sexp_of]
-
-val create : unit -> _ t
-val set_key : ('a, _) t -> 'a Heap_block.t option -> unit
-val get_key : ('a, _) t -> 'a Heap_block.t option
-val set_data : (_, 'b) t -> 'b Heap_block.t option -> unit
-val get_data : (_, 'b) t -> 'b Heap_block.t option
-val is_key_some : _ t -> bool
-val is_key_none : _ t -> bool
-val is_data_some : _ t -> bool
-val is_data_none : _ t -> bool
+include module type of Caml.Ephemeron

core/src/gc.ml

@@ -110,6 +110,8 @@ module Stable = struct
   end
 
   module Control = struct
+    [%%if ocaml_version < (5, 0, 0)]
+
     module V1 = struct
       [@@@ocaml.warning "-3"]
 
@@ -128,6 +130,29 @@ module Stable = struct
         }
       [@@deriving bin_io, compare, equal, sexp]
     end
+
+    [%% else]
+
+    module V1 = struct
+      [@@@ocaml.warning "-3"]
+
+      type t = Caml.Gc.control =
+        { minor_heap_size : int
+        ; major_heap_increment : int
+        ; space_overhead : int
+        ; verbose : int
+        ; max_overhead : int
+        ; stack_limit : int
+        ; allocation_policy : int
+        ; window_size : int
+        ; custom_major_ratio : int
+        ; custom_minor_ratio : int
+        ; custom_minor_max_size : int
+        }
+      [@@deriving bin_io, compare, equal, sexp]
+    end
+
+    [%%endif]
   end
 end
 
@@ -236,6 +261,8 @@ module Stat = struct
 end
 
 module Control = struct
+  [%%if ocaml_version < (5, 0, 0)]
+
   module T = struct
     [@@@ocaml.warning "-3"]
 
@@ -255,6 +282,29 @@ module Control = struct
     [@@deriving compare, sexp_of, fields]
   end
 
+  [%% else]
+
+  module T = struct
+    [@@@ocaml.warning "-3"]
+
+    type t = Caml.Gc.control =
+      { minor_heap_size : int
+      ; major_heap_increment : int
+      ; space_overhead : int
+      ; verbose : int
+      ; max_overhead : int
+      ; stack_limit : int
+      ; allocation_policy : int
+      ; window_size : int
+      ; custom_major_ratio : int
+      ; custom_minor_ratio : int
+      ; custom_minor_max_size : int
+      }
+    [@@deriving compare, sexp_of, fields]
+  end
+
+  [%% endif]
+
   include T
   include Comparable.Make_plain (T)
 end
@@ -339,13 +389,9 @@ external major_words : unit -> int = "core_gc_major_words" [@@noalloc]
 external promoted_words : unit -> int = "core_gc_promoted_words" [@@noalloc]
 external minor_collections : unit -> int = "core_gc_minor_collections" [@@noalloc]
 external major_collections : unit -> int = "core_gc_major_collections" [@@noalloc]
-external heap_words : unit -> int = "core_gc_heap_words" [@@noalloc]
-external heap_chunks : unit -> int = "core_gc_heap_chunks" [@@noalloc]
 external compactions : unit -> int = "core_gc_compactions" [@@noalloc]
-external top_heap_words : unit -> int = "core_gc_top_heap_words" [@@noalloc]
 external major_plus_minor_words : unit -> int = "core_gc_major_plus_minor_words"
 external allocated_words : unit -> int = "core_gc_allocated_words"
-external run_memprof_callbacks : unit -> unit = "core_gc_run_memprof_callbacks"
 
 let zero = Sys.opaque_identity (int_of_string "0")
 
@@ -466,11 +512,9 @@ module For_testing = struct
         (* Memprof.stop does not guarantee that all memprof callbacks are run (some may be
            delayed if they happened during C code and there has been no allocation since),
            so we explictly flush them *)
-        run_memprof_callbacks ();
         Caml.Gc.Memprof.stop ();
         x
       | exception e ->
-        run_memprof_callbacks ();
         Caml.Gc.Memprof.stop ();
         raise e
     in

core/src/gc.mli

@@ -123,6 +123,8 @@ type stat = Stat.t
 *)
 
 module Control : sig
+  [%%if ocaml_version < (5, 0, 0)]
+
   type t =
     { mutable minor_heap_size : int
     (** The size (in words) of the minor heap.  Changing this parameter will
@@ -227,6 +229,115 @@ module Control : sig
     }
   [@@deriving sexp_of, fields]
 
+  [%% else]
+
+
+  type t =
+    { minor_heap_size : int
+    (** The size (in words) of the minor heap.  Changing this parameter will
+        trigger a minor collection.
+
+        Default: 262144 words / 1MB (32bit) / 2MB (64bit).
+    *)
+    ; major_heap_increment : int
+    (** How much to add to the major heap when increasing it. If this
+        number is less than or equal to 1000, it is a percentage of
+        the current heap size (i.e. setting it to 100 will double the heap
+        size at each increase). If it is more than 1000, it is a fixed
+        number of words that will be added to the heap.
+
+        Default: 15%.
+    *)
+    ; space_overhead : int
+    (** The major GC speed is computed from this parameter.
+        This is the memory that will be "wasted" because the GC does not
+        immediately collect unreachable blocks.  It is expressed as a
+        percentage of the memory used for live data.
+        The GC will work more (use more CPU time and collect
+        blocks more eagerly) if [space_overhead] is smaller.
+
+        Default: 80. *)
+    ; verbose : int
+    (** This value controls the GC messages on standard error output.
+        It is a sum of some of the following flags, to print messages
+        on the corresponding events:
+        - [0x001] Start of major GC cycle.
+        - [0x002] Minor collection and major GC slice.
+        - [0x004] Growing and shrinking of the heap.
+        - [0x008] Resizing of stacks and memory manager tables.
+        - [0x010] Heap compaction.
+        - [0x020] Change of GC parameters.
+        - [0x040] Computation of major GC slice size.
+        - [0x080] Calling of finalisation functions.
+        - [0x100] Bytecode executable search at start-up.
+        - [0x200] Computation of compaction triggering condition.
+
+        Default: 0. *)
+    ; max_overhead : int
+    (** Heap compaction is triggered when the estimated amount
+        of "wasted" memory is more than [max_overhead] percent of the
+        amount of live data.  If [max_overhead] is set to 0, heap
+        compaction is triggered at the end of each major GC cycle
+        (this setting is intended for testing purposes only).
+        If [max_overhead >= 1000000], compaction is never triggered.
+
+        Default: 500. *)
+    ; stack_limit : int
+    (** The maximum size of the stack (in words).  This is only
+        relevant to the byte-code runtime, as the native code runtime
+        uses the operating system's stack.
+
+        Default: 1048576 words / 4MB (32bit) / 8MB (64bit). *)
+    ; allocation_policy : int
+    (** The policy used for allocating in the heap.  Possible
+        values are 0 and 1.  0 is the next-fit policy, which is
+        quite fast but can result in fragmentation.  1 is the
+        first-fit policy, which can be slower in some cases but
+        can be better for programs with fragmentation problems.
+
+        Default: 0. *)
+    ; window_size : int
+    (** The size of the window used by the major GC for smoothing
+        out variations in its workload. This is an integer between
+        1 and 50.
+
+        Default: 1. @since 4.03.0 *)
+    ; custom_major_ratio : int
+    (** Target ratio of floating garbage to major heap size for
+        out-of-heap memory held by custom values located in the major
+        heap. The GC speed is adjusted to try to use this much memory
+        for dead values that are not yet collected. Expressed as a
+        percentage of major heap size. The default value keeps the
+        out-of-heap floating garbage about the same size as the
+        in-heap overhead.
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 44.
+        @since 4.08.0 *)
+    ; custom_minor_ratio : int
+    (** Bound on floating garbage for out-of-heap memory held by
+        custom values in the minor heap. A minor GC is triggered when
+        this much memory is held by custom values located in the minor
+        heap. Expressed as a percentage of minor heap size.
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 100.
+        @since 4.08.0 *)
+    ; custom_minor_max_size : int
+    (** Maximum amount of out-of-heap memory for each custom value
+        allocated in the minor heap. When a custom value is allocated
+        on the minor heap and holds more than this many bytes, only
+        this value is counted against [custom_minor_ratio] and the
+        rest is directly counted against [custom_major_ratio].
+        Note: this only applies to values allocated with
+        [caml_alloc_custom_mem] (e.g. bigarrays).
+        Default: 8192 bytes.
+        @since 4.08.0 *)
+    }
+  [@@deriving sexp_of, fields]
+
+  [%% endif]
+
   include Comparable.S_plain with type t := t
 end
 
@@ -267,10 +378,7 @@ external major_words : unit -> int = "core_gc_major_words" [@@noalloc]
 external promoted_words : unit -> int = "core_gc_promoted_words" [@@noalloc]
 external minor_collections : unit -> int = "core_gc_minor_collections" [@@noalloc]
 external major_collections : unit -> int = "core_gc_major_collections" [@@noalloc]
-external heap_words : unit -> int = "core_gc_heap_words" [@@noalloc]
-external heap_chunks : unit -> int = "core_gc_heap_chunks" [@@noalloc]
 external compactions : unit -> int = "core_gc_compactions" [@@noalloc]
-external top_heap_words : unit -> int = "core_gc_top_heap_words" [@@noalloc]
 
 (** This function returns [major_words () + minor_words ()].  It exists purely for speed
     (one call into C rather than two).  Like [major_words] and [minor_words],

core/src/gc_stubs.c

@@ -45,26 +45,12 @@ CAMLprim value core_gc_major_collections(value unit __attribute__((unused)))
   return Val_long(caml_stat_major_collections);
 }
 
-CAMLprim value core_gc_heap_words(value unit __attribute__((unused)))
-{
-  return Val_long(caml_stat_heap_wsz);
-}
-
-CAMLprim value core_gc_heap_chunks(value unit __attribute__((unused)))
-{
-  return Val_long(caml_stat_heap_chunks);
-}
 
 CAMLprim value core_gc_compactions(value unit __attribute__((unused)))
 {
   return Val_long(caml_stat_compactions);
 }
 
-CAMLprim value core_gc_top_heap_words(value unit __attribute__((unused)))
-{
-  return Val_long(caml_stat_top_heap_wsz);
-}
-
 CAMLprim value core_gc_major_plus_minor_words(value unit __attribute__((unused)))
 {
   return Val_long(minor_words() + major_words());
@@ -74,10 +60,3 @@ CAMLprim value core_gc_allocated_words(value unit __attribute__((unused)))
 {
   return Val_long(minor_words() + major_words() - promoted_words());
 }
-
-CAMLprim value core_gc_run_memprof_callbacks(value unit __attribute__((unused)))
-{
-  value exn = caml_memprof_handle_postponed_exn();
-  caml_raise_if_exception(exn);
-  return Val_unit;
-}

core/src/md5_stubs.c

@@ -1,3 +1,4 @@
+#define CAML_INTERNALS
 #include <unistd.h>
 #include <errno.h>
 #include <caml/alloc.h>
@@ -7,10 +8,10 @@
 #include <caml/bigarray.h>
 #include <core_params.h>
 
-#define CAML_INTERNALS
 #if __GNUC__ < 8
 #pragma GCC diagnostic ignored "-pedantic"
 #endif
+
 #include <caml/md5.h>
 #include <caml/sys.h>
 #undef CAML_INTERNALS