Add Runtimetags module (#2063)

* Add `Runtimetags` module.

* Add test.

Author: xclerc

ocaml/.depend

@@ -216,6 +216,11 @@ utils/profile.cmx : \
     utils/misc.cmx \
     utils/profile.cmi
 utils/profile.cmi :
+utils/runtimetags.cmo : \
+    utils/runtimetags.cmi
+utils/runtimetags.cmx : \
+    utils/runtimetags.cmi
+utils/runtimetags.cmi :
 utils/strongly_connected_components.cmo : \
     utils/numbers.cmi \
     utils/misc.cmi \
@@ -230,13 +235,15 @@ utils/symbol.cmo : \
     utils/linkage_name.cmi \
     utils/identifiable.cmi \
     typing/ident.cmi \
+    utils/config.cmi \
     utils/compilation_unit.cmi \
     utils/symbol.cmi
 utils/symbol.cmx : \
     utils/misc.cmx \
     utils/linkage_name.cmx \
     utils/identifiable.cmx \
     typing/ident.cmx \
+    utils/config.cmx \
     utils/compilation_unit.cmx \
     utils/symbol.cmi
 utils/symbol.cmi : \
@@ -1853,7 +1860,6 @@ typing/typedecl.cmi : \
     typing/ident.cmi \
     typing/errortrace.cmi \
     typing/env.cmi \
-    parsing/builtin_attributes.cmi \
     parsing/asttypes.cmi
 typing/typedecl_properties.cmo : \
     typing/types.cmi \
@@ -3705,11 +3711,13 @@ middle_end/clambda.cmi : \
 middle_end/clambda_primitives.cmo : \
     typing/types.cmi \
     typing/primitive.cmi \
+    utils/misc.cmi \
     lambda/lambda.cmi \
     middle_end/clambda_primitives.cmi
 middle_end/clambda_primitives.cmx : \
     typing/types.cmx \
     typing/primitive.cmx \
+    utils/misc.cmx \
     lambda/lambda.cmx \
     middle_end/clambda_primitives.cmi
 middle_end/clambda_primitives.cmi : \
@@ -3955,6 +3963,7 @@ lambda/matching.cmo : \
     typing/ident.cmi \
     typing/env.cmi \
     lambda/debuginfo.cmi \
+    utils/config.cmi \
     utils/clflags.cmi \
     typing/btype.cmi \
     parsing/asttypes.cmi \
@@ -3978,6 +3987,7 @@ lambda/matching.cmx : \
     typing/ident.cmx \
     typing/env.cmx \
     lambda/debuginfo.cmx \
+    utils/config.cmx \
     utils/clflags.cmx \
     typing/btype.cmx \
     parsing/asttypes.cmi \
@@ -4594,6 +4604,7 @@ middle_end/closure/closure.cmo : \
     typing/env.cmi \
     lambda/debuginfo.cmi \
     middle_end/convert_primitives.cmi \
+    utils/config.cmi \
     middle_end/compilenv.cmi \
     utils/compilation_unit.cmi \
     utils/clflags.cmi \
@@ -4619,6 +4630,7 @@ middle_end/closure/closure.cmx : \
     typing/env.cmx \
     lambda/debuginfo.cmx \
     middle_end/convert_primitives.cmx \
+    utils/config.cmx \
     middle_end/compilenv.cmx \
     utils/compilation_unit.cmx \
     utils/clflags.cmx \
@@ -4815,6 +4827,7 @@ middle_end/flambda/closure_conversion.cmo : \
     middle_end/flambda/flambda.cmi \
     lambda/debuginfo.cmi \
     middle_end/convert_primitives.cmi \
+    utils/config.cmi \
     utils/compilation_unit.cmi \
     middle_end/flambda/base_types/closure_origin.cmi \
     middle_end/flambda/base_types/closure_id.cmi \
@@ -4844,6 +4857,7 @@ middle_end/flambda/closure_conversion.cmx : \
     middle_end/flambda/flambda.cmx \
     lambda/debuginfo.cmx \
     middle_end/convert_primitives.cmx \
+    utils/config.cmx \
     utils/compilation_unit.cmx \
     middle_end/flambda/base_types/closure_origin.cmx \
     middle_end/flambda/base_types/closure_id.cmx \

ocaml/compilerlibs/Makefile.compilerlibs

@@ -25,6 +25,7 @@
 # that they are consistent with the interface digests in the archives.
 
 UTILS = \
+  utils/runtimetags.cmo \
   utils/config.cmo \
   utils/build_path_prefix_map.cmo \
   utils/misc.cmo \

ocaml/dune

@@ -98,7 +98,7 @@
    annot outcometree
 
    ;; lambda/
-   debuginfo lambda matching printlambda runtimedef tmc simplif switch
+   debuginfo lambda matching printlambda runtimedef runtimetags tmc simplif switch
    translmode
    transl_comprehension_utils
    transl_array_comprehension transl_list_comprehension
@@ -331,6 +331,7 @@
     (matching.mli as compiler-libs/matching.mli)
     (printlambda.mli as compiler-libs/printlambda.mli)
     (runtimedef.mli as compiler-libs/runtimedef.mli)
+    (runtimetags.mli as compiler-libs/runtimetags.mli)
     (simplif.mli as compiler-libs/simplif.mli)
     (switch.mli as compiler-libs/switch.mli)
     (translmode.mli as compiler-libs/translmode.mli)

ocaml/otherlibs/dynlink/Makefile

@@ -72,6 +72,7 @@ COMPILERLIBS_INTFS=\
 
 # .ml files from compilerlibs that have corresponding .mli files.
 COMPILERLIBS_SOURCES=\
+  utils/runtimetags.ml \
   utils/binutils.ml \
   utils/config.ml \
   utils/build_path_prefix_map.ml \

ocaml/otherlibs/dynlink/dune

@@ -95,6 +95,7 @@
     debuginfo
     lambda
     runtimedef
+    runtimetags
     instruct
     opcodes
     bytesections
@@ -129,6 +130,7 @@
 ;  (package ocaml))
 
 ;; .ml:
+(copy_files ../../utils/runtimetags.ml)
 (copy_files ../../utils/binutils.ml)
 (copy_files ../../utils/local_store.ml)
 (copy_files ../../utils/config.ml)
@@ -190,6 +192,7 @@
 (copy_files ../../bytecomp/symtable.ml)
 
 ;; .mli:
+(copy_files ../../utils/runtimetags.mli)
 (copy_files ../../utils/binutils.mli)
 (copy_files ../../utils/local_store.mli)
 (copy_files ../../utils/config.mli)
@@ -298,6 +301,7 @@
       %{deps}))
   (deps
       ; NOTE: Be sure to keep these arguments in dependency order!
+      .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Runtimetags.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Int_replace_polymorphic_compare.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Binutils.cmo
       .dynlink_compilerlibs.objs/byte/dynlink_compilerlibs__Local_store.cmo
@@ -376,6 +380,7 @@
       %{deps}))
   (deps
       ; NOTE: Be sure to keep these arguments in dependency order!
+      .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Runtimetags.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Int_replace_polymorphic_compare.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Binutils.cmx
       .dynlink_compilerlibs.objs/native/dynlink_compilerlibs__Local_store.cmx

ocaml/testsuite/tests/compiler-libs/test_runtimetags.ml

@@ -0,0 +1,57 @@
+(* TEST
+   flags = "-I ${ocamlsrcdir}/utils"
+   include ocamlcommon
+ * expect
+*)
+
+let check_tag name left right =
+  match Int.equal left right with
+  | true -> Format.printf "values for %S agree@." name
+  | false -> Format.printf "values for %S disagree (%d vs %d)@." name left right
+
+let check_tags l =
+  List.iter (fun (name, left, right) -> check_tag name left right) l
+
+let () = check_tags [
+  "first_non_constant_constructor_tag", Obj.first_non_constant_constructor_tag, Runtimetags.first_non_constant_constructor_tag;
+  "last_non_constant_constructor_tag", Obj.last_non_constant_constructor_tag, Runtimetags.last_non_constant_constructor_tag;
+  "forcing_tag", Obj.forcing_tag, Runtimetags.forcing_tag;
+  "cont_tag", Obj.cont_tag, Runtimetags.cont_tag;
+  "lazy_tag", Obj.lazy_tag, Runtimetags.lazy_tag;
+  "closure_tag", Obj.closure_tag, Runtimetags.closure_tag;
+  "object_tag", Obj.object_tag, Runtimetags.object_tag;
+  "infix_tag", Obj.infix_tag, Runtimetags.infix_tag;
+  "forward_tag", Obj.forward_tag, Runtimetags.forward_tag;
+  "no_scan_tag", Obj.no_scan_tag, Runtimetags.no_scan_tag;
+  "abstract_tag", Obj.abstract_tag, Runtimetags.abstract_tag;
+  "string_tag", Obj.string_tag, Runtimetags.string_tag;
+  "double_tag", Obj.double_tag, Runtimetags.double_tag;
+  "double_array_tag", Obj.double_array_tag, Runtimetags.double_array_tag;
+  "custom_tag", Obj.custom_tag, Runtimetags.custom_tag;
+  "int_tag", Obj.int_tag, Runtimetags.int_tag;
+  "out_of_heap_tag", Obj.out_of_heap_tag, Runtimetags.out_of_heap_tag;
+  "unaligned_tag", Obj.unaligned_tag, Runtimetags.unaligned_tag;
+]
+
+[%%expect{|
+val check_tag : string -> int -> int -> unit = <fun>
+val check_tags : (string * int * int) list -> unit = <fun>
+values for "first_non_constant_constructor_tag" agree
+values for "last_non_constant_constructor_tag" agree
+values for "forcing_tag" agree
+values for "cont_tag" agree
+values for "lazy_tag" agree
+values for "closure_tag" agree
+values for "object_tag" agree
+values for "infix_tag" agree
+values for "forward_tag" agree
+values for "no_scan_tag" agree
+values for "abstract_tag" agree
+values for "string_tag" agree
+values for "double_tag" agree
+values for "double_array_tag" agree
+values for "custom_tag" agree
+values for "int_tag" agree
+values for "out_of_heap_tag" agree
+values for "unaligned_tag" agree
+|}]

ocaml/utils/runtimetags.ml

@@ -0,0 +1,35 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Max Slater, Jane Street                           *)
+(*                                                                        *)
+(*   Copyright 2023 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Defines the runtime tags used by the target runtime.
+   Must be kept in sync with ocaml/stdlib/obj.ml and ocaml/runtime/caml/mlvalues.h *)
+
+let first_non_constant_constructor_tag = 0
+let last_non_constant_constructor_tag = 243
+let forcing_tag = 244
+let cont_tag = 245
+let lazy_tag = 246
+let closure_tag = 247
+let object_tag = 248
+let infix_tag = 249
+let forward_tag = 250
+let no_scan_tag = 251
+let abstract_tag = 251
+let string_tag = 252
+let double_tag = 253
+let double_array_tag = 254
+let custom_tag = 255
+let int_tag = 1000
+let out_of_heap_tag = 1001
+let unaligned_tag = 1002

ocaml/utils/runtimetags.mli

@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*                      Max Slater, Jane Street                           *)
+(*                                                                        *)
+(*   Copyright 2023 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+val first_non_constant_constructor_tag : int
+val last_non_constant_constructor_tag : int
+val forcing_tag : int
+val cont_tag : int
+val lazy_tag : int
+val closure_tag : int
+val object_tag : int
+val infix_tag : int
+val forward_tag : int
+val no_scan_tag : int
+val abstract_tag : int
+val string_tag : int
+val double_tag : int
+val double_array_tag : int
+val custom_tag : int
+val int_tag : int
+val out_of_heap_tag : int
+val unaligned_tag : int