Successful build with --enable-runtime5 (#2017)

* Install runtime/caml headers

Updates the dune build system to install the runtime5 headers.

Covers #77

* Add CAML_RUNTIME_5 macro to runtime.

This allows code using the runtime (particularly otherlibs/) to condition on 4 vs. 5.
Alternatively, otherlibs/ could be duplicated between 4 and 5, but only minimal changes were necessary.

* unix/fork.c conditionals

When building with runtime5, fork needs to use runtime_events instead of eventlog.

* unix/signals.c conditionals

Runtime5 removes caml_sigmask_hook, so the code should use pthread_sigmask directly.
See CR for discussion - the upstream unix/signals.c uses sigprocmask, which seems incorrect.

* Upstream build system fixes

- Fixes unquoted 'yes' call
- Fixes unsubstituted runtime_suffix generator
- Disables stack allocation when runtime5 is enabled
- Regenerates configure script

* Add runtime5 compile-time constant

Implements "%runtime5" primitive for checking whether we're configured with runtime5 at compile time.
In the compiler, it just returns the config bool.
In runtime/ it returns true; in runtime4/ false.

Also implements caml_sys_const_naked_pointers_checked in runtime/.

* Runtime5 global symbol seperator

Runtime5 renames global symbols to 'caml_module.name' instead of 'caml_module__name'.
The backend now cases on the configured runtime.

* Forward port caml_flambda2_invalid

Implements caml_flambda2_invalid runtime diagonstic.
See #530

* Forward port caml_obj_make_forward

Runtime/ did not include this function, so the implementation is copied from runtime4.
The same code works with the new OCaml 5 lazy implementation.

* With_async_exns conditional

Uses the runtime5 compile-time constant to conditionally implement with_async_exns as a try/catch block.
Future work will implement with_async_exns properly in runtime5, at which point this should be removed.

* Bootstrap 4 compiler

Author: TheNumbat

middle_end/closure/closure.ml

@@ -1342,6 +1342,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars; kinds; catch_env } as env)
         | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
         | Backend_type ->
             make_const_int 0 (* tag 0 is the same as Native here *)
+        | Runtime5 -> make_const_bool Config.runtime5
       in
       let arg, _approx = close env arg in
       let id = Ident.create_local "dummy" in

middle_end/flambda/closure_conversion.ml

@@ -456,6 +456,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         | Ostype_cygwin -> lambda_const_bool (String.equal Sys.os_type "Cygwin")
         | Backend_type ->
             Lambda.const_int 0 (* tag 0 is the same as Native *)
+        | Runtime5 -> lambda_const_bool Config.runtime5
         end
       in
       close t env

middle_end/flambda2/from_lambda/lambda_to_flambda_primitives.ml

@@ -1241,7 +1241,8 @@ let convert_lprim ~big_endian (prim : L.primitive) (args : Simple.t list list)
     | Ostype_win32 -> [Simple (Simple.const_bool (Sys.os_type = "Win32"))]
     | Ostype_cygwin -> [Simple (Simple.const_bool (Sys.os_type = "Cygwin"))]
     | Backend_type ->
-      [Simple Simple.const_zero] (* constructor 0 is the same as Native here *))
+      [Simple Simple.const_zero] (* constructor 0 is the same as Native here *)
+    | Runtime5 -> [Simple (Simple.const_bool Config.runtime5)])
   | Pbswap16, [[arg]] ->
     [ tag_int
         (Unary (Int_arith (Naked_immediate, Swap_byte_endianness), untag_int arg))

ocaml/boot/ocamlc

@@ -508,7 +508,8 @@ let comp_primitive stack_info p sz args =
        | Ostype_unix -> "ostype_unix"
        | Ostype_win32 -> "ostype_win32"
        | Ostype_cygwin -> "ostype_cygwin"
-       | Backend_type -> "backend_type" in
+       | Backend_type -> "backend_type"
+       | Runtime5 -> "runtime5" in
      Kccall(Printf.sprintf "caml_sys_const_%s" const_name, 1)
   | Pisint _ -> Kisint
   | Pisout -> Kisout

ocaml/boot/ocamllex

@@ -2118,8 +2118,10 @@ AS_CASE([$host],
 
 ## Activate the systhread library
 
-if [ "$enable_runtime5" = "yes" ]; then
+if [[ x"$enable_runtime5" = x"yes" ]]; then
   runtime_suffix=
+  # CR ocaml 5 runtime: forward port locals
+  enable_stack_allocation="no"
 else
   runtime_suffix=4
 fi
@@ -2132,7 +2134,8 @@ AS_CASE([$enable_systhreads,$enable_unix_lib],
     [systhread_support=false
     AC_MSG_NOTICE([the threads library is disabled])],
   [systhread_support=true
-  AC_CONFIG_FILES([otherlibs/systhreads${runtime_suffix}/META])
+  AC_CONFIG_FILES([otherlibs/systhreads/META])
+  AC_CONFIG_FILES([otherlibs/systhreads4/META])
   otherlibraries="$otherlibraries systhreads${runtime_suffix}"
   lib_systhreads=true
   lib_systhreads_path="systhreads${runtime_suffix}"

ocaml/bytecomp/bytegen.ml

@@ -27,6 +27,7 @@ type compile_time_constant =
   | Ostype_win32
   | Ostype_cygwin
   | Backend_type
+  | Runtime5
 
 type immediate_or_pointer =
   | Immediate
@@ -1624,7 +1625,7 @@ let primitive_result_layout (p : primitive) =
       end
   | Pctconst (
       Big_endian | Word_size | Int_size | Max_wosize
-      | Ostype_unix | Ostype_cygwin | Ostype_win32 | Backend_type
+      | Ostype_unix | Ostype_cygwin | Ostype_win32 | Backend_type | Runtime5
     ) ->
       (* Compile-time constants only ever return ints for now,
          enumerate them all to be sure to modify this if it becomes wrong. *)

ocaml/configure

@@ -29,6 +29,7 @@ type compile_time_constant =
   | Ostype_win32
   | Ostype_cygwin
   | Backend_type
+  | Runtime5
 
 type immediate_or_pointer =
   | Immediate

ocaml/configure.ac

@@ -432,7 +432,8 @@ let primitive ppf = function
        | Ostype_unix -> "ostype_unix"
        | Ostype_win32 -> "ostype_win32"
        | Ostype_cygwin -> "ostype_cygwin"
-       | Backend_type -> "backend_type" in
+       | Backend_type -> "backend_type"
+       | Runtime5 -> "runtime5" in
      fprintf ppf "sys.constant_%s" const_name
   | Pisint { variant_only } ->
       fprintf ppf (if variant_only then "isint" else "obj_is_int")

ocaml/lambda/lambda.ml

@@ -186,6 +186,7 @@ let lookup_primitive loc poly pos p =
     | "%ostype_unix" -> Primitive ((Pctconst Ostype_unix), 1)
     | "%ostype_win32" -> Primitive ((Pctconst Ostype_win32), 1)
     | "%ostype_cygwin" -> Primitive ((Pctconst Ostype_cygwin), 1)
+    | "%runtime5" -> Primitive ((Pctconst Runtime5), 1)
     | "%frame_pointers" -> Frame_pointers
     | "%negint" -> Primitive (Pnegint, 1)
     | "%succint" -> Primitive ((Poffsetint 1), 1)

ocaml/lambda/lambda.mli

@@ -1305,6 +1305,7 @@ let rec close ({ backend; fenv; cenv ; mutable_vars; kinds; catch_env } as env)
         | Ostype_cygwin -> make_const_bool (Sys.os_type = "Cygwin")
         | Backend_type ->
             make_const_int 0 (* tag 0 is the same as Native here *)
+        | Runtime5 -> make_const_bool Config.runtime5
       in
       let arg, _approx = close env arg in
       let id = Ident.create_local "dummy" in

ocaml/lambda/printlambda.ml

@@ -451,6 +451,7 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
         | Ostype_cygwin -> lambda_const_bool (String.equal Sys.os_type "Cygwin")
         | Backend_type ->
             Lambda.const_int 0 (* tag 0 is the same as Native *)
+        | Runtime5 -> lambda_const_bool Config.runtime5
         end
       in
       close t env

ocaml/lambda/translprim.ml

@@ -17,16 +17,16 @@
 
 #include <caml/mlvalues.h>
 #include <caml/debugger.h>
-#if 0 /* BACKPORT BEGIN */
+#ifdef CAML_RUNTIME_5
 #include <caml/runtime_events.h>
-#endif
+#else
 #include <caml/eventlog.h>
-/* BACKPORT END */
+#endif
 #include "unixsupport.h"
 #include <caml/domain.h>
 #include <caml/fail.h>
 
-#if 0 /* BACKPORT */
+#ifdef CAML_RUNTIME_5
 /* Post-fork tasks to be carried out in the parent */
 void caml_atfork_parent(pid_t child_pid) {
   CAML_EV_LIFECYCLE(EV_FORK_PARENT, child_pid);
@@ -42,35 +42,34 @@ void caml_atfork_child(void) {
 CAMLprim value caml_unix_fork(value unit)
 {
   int ret;
- /* BACKPORT
+
+#ifdef CAML_RUNTIME_5
   if (caml_domain_is_multicore()) {
     caml_failwith
       ("Unix.fork may not be called while other domains were created");
   }
-*/
-
-/* BACKPORT BEGIN */
+#else
   CAML_EV_FLUSH();
-/* BACKPORT END */
+#endif
 
   ret = fork();
 
   if (ret == -1) caml_uerror("fork", Nothing);
 
-#if 0 /* BACKPORT BEGIN */
+#ifdef CAML_RUNTIME_5
   if (ret == 0) {
     caml_atfork_child();
     /* the following hook can be redefined in other places */
     caml_atfork_hook();
   } else {
     caml_atfork_parent(ret);
   }
-#endif
+#else
   CAML_EVENTLOG_DO({
       if (ret == 0)
         caml_eventlog_disable();
   });
-/* BACKPORT END */
+#endif
 
   if (caml_debugger_in_use)
     if ((caml_debugger_fork_mode && ret == 0) ||

ocaml/middle_end/closure/closure.ml

@@ -74,7 +74,16 @@ CAMLprim value caml_unix_sigprocmask(value vaction, value vset)
   how = sigprocmask_cmd[Int_val(vaction)];
   decode_sigset(vset, &set);
   caml_enter_blocking_section();
+#ifdef CAML_RUNTIME_5
+  // CR ocaml 5 runtime: the upstream 5.0 unix lib uses sigprocmask here,
+  // which seems wrong? Previously, there was a global caml_sigmask_hook wrapper
+  // that got installed as sigprocmask or pthread_sigmask based on whether
+  // systhreads was enabled. The 5 runtime is now multithreaded, so always
+  // links pthread, so should always use pthread_sigmask.
+  retcode = pthread_sigmask(how, &set, &oldset);
+#else
   retcode = caml_sigmask_hook(how, &set, &oldset);
+#endif
   caml_leave_blocking_section();
   /* Run any handlers for just-unmasked pending signals */
   caml_process_pending_actions();

ocaml/middle_end/flambda/closure_conversion.ml

@@ -427,8 +427,8 @@ caml_ml_array_bound_error:
 caml_system__code_end:
 
         .DATA
-        PUBLIC  caml_system__frametable
-caml_system__frametable LABEL QWORD
+        PUBLIC  caml_system.frametable
+caml_system.frametable LABEL QWORD
         QWORD   1           ; one descriptor
         QWORD   L107        ; return address into callback
         WORD    -1          ; negative frame size => use callback link

ocaml/otherlibs/unix/fork.c

@@ -309,6 +309,11 @@ CAMLexport value caml_callbackN (value closure, int narg, value args[])
   return caml_raise_if_exception(caml_callbackN_exn(closure, narg, args));
 }
 
+CAMLprim value caml_with_async_exns(value body_callback)
+{
+  caml_failwith("Called caml_with_async_exns in runtime5: not implemented.");
+}
+
 /* Naming of OCaml values */
 
 struct named_value {

ocaml/otherlibs/unix/signals.c

@@ -16,6 +16,8 @@
 #ifndef CAML_CONFIG_H
 #define CAML_CONFIG_H
 
+#define CAML_RUNTIME_5
+
 /* CAML_NAME_SPACE was introduced in OCaml 3.08 to declare compatibility with
    the newly caml_-prefixed names of C runtime functions and to disable the
    definition of compatibility macros for the un-prefixed names. The

ocaml/runtime/amd64nt.asm

@@ -27,3 +27,74 @@
  (action
    (with-stdout-to %{targets}
      (run %{dep:../../tools/make-version-header.sh} %{dep:../../VERSION}))))
+
+(install
+  (files
+    (address_class.h as caml/address_class.h)
+    (addrmap.h as caml/addrmap.h)
+    (alloc.h as caml/alloc.h)
+    (atomic_refcount.h as caml/atomic_refcount.h)
+    (backtrace_prim.h as caml/backtrace_prim.h)
+    (backtrace.h as caml/backtrace.h)
+    (bigarray.h as caml/bigarray.h)
+    (callback.h as caml/callback.h)
+    (camlatomic.h as caml/camlatomic.h)
+    (codefrag.h as caml/codefrag.h)
+    (compact.h as caml/compact.h)
+    (compare.h as caml/compare.h)
+    (config.h as caml/config.h)
+    (custom.h as caml/custom.h)
+    (debugger.h as caml/debugger.h)
+    (domain_state.h as caml/domain_state.h)
+    (domain_state.tbl as caml/domain_state.tbl)
+    (domain.h as caml/domain.h)
+    (dynlink.h as caml/dynlink.h)
+    (exec.h as caml/exec.h)
+    (fail.h as caml/fail.h)
+    (fiber.h as caml/fiber.h)
+    (finalise.h as caml/finalise.h)
+    (fix_code.h as caml/fix_code.h)
+    (frame_descriptors.h as caml/frame_descriptors.h)
+    (gc_ctrl.h as caml/gc_ctrl.h)
+    (gc_stats.h as caml/gc_stats.h)
+    (gc.h as caml/gc.h)
+    (globroots.h as caml/globroots.h)
+    (hash.h as caml/hash.h)
+    (hooks.h as caml/hooks.h)
+    (instrtrace.h as caml/instrtrace.h)
+    (instruct.h as caml/instruct.h)
+    (interp.h as caml/interp.h)
+    (intext.h as caml/intext.h)
+    (io.h as caml/io.h)
+    (lf_skiplist.h as caml/lf_skiplist.h)
+    (m.h as caml/m.h)
+    (major_gc.h as caml/major_gc.h)
+    (md5.h as caml/md5.h)
+    (memory.h as caml/memory.h)
+    (memprof.h as caml/memprof.h)
+    (minor_gc.h as caml/minor_gc.h)
+    (misc.h as caml/misc.h)
+    (mlvalues.h as caml/mlvalues.h)
+    (osdeps.h as caml/osdeps.h)
+    (platform.h as caml/platform.h)
+    (prims.h as caml/prims.h)
+    (printexc.h as caml/printexc.h)
+    (reverse.h as caml/reverse.h)
+    (roots.h as caml/roots.h)
+    (runtime_events.h as caml/runtime_events.h)
+    (s.h as caml/s.h)
+    (shared_heap.h as caml/shared_heap.h)
+    (signals.h as caml/signals.h)
+    (sizeclasses.h as caml/sizeclasses.h)
+    (skiplist.h as caml/skiplist.h)
+    (stack.h as caml/stack.h)
+    (startup_aux.h as caml/startup_aux.h)
+    (startup.h as caml/startup.h)
+    (sync.h as caml/sync.h)
+    (sys.h as caml/sys.h)
+    (version.h as caml/version.h)
+    (weak.h as caml/weak.h)
+    (winsupport.h as caml/winsupport.h)
+  )
+  (section lib)
+  (package ocaml_runtime_stdlib))

ocaml/runtime/callback.c

@@ -250,3 +250,18 @@ void caml_bad_caml_state(void)
 {
   caml_fatal_error("no domain lock held");
 }
+
+/* Flambda 2 invalid term markers */
+
+CAMLnoreturn_start
+void caml_flambda2_invalid (value message)
+CAMLnoreturn_end;
+
+void caml_flambda2_invalid (value message)
+{
+  fprintf (stderr, "[ocaml] [flambda2] Invalid code:\n%s\n\n",
+    String_val(message));
+  fprintf (stderr, "This might have arisen from a wrong use of [Obj.magic].\n");
+  fprintf (stderr, "Consider using [Sys.opaque_identity].\n");
+  abort ();
+}

ocaml/runtime/caml/config.h

@@ -66,6 +66,13 @@ CAMLprim value caml_obj_set_raw_field(value arg, value pos, value bits)
   return Val_unit;
 }
 
+CAMLprim value caml_obj_make_forward(value blk, value fwd)
+{
+  caml_modify(&Field(blk, 0), fwd);
+  Tag_val (blk) = Forward_tag;
+  return Val_unit;
+}
+
 /* [size] is a value encoding a number of blocks */
 CAMLprim value caml_obj_block(value tag, value size)
 {