flambda-backend: Merge ocaml-jst

.github/workflows/build.yml

@@ -21,13 +21,6 @@ jobs:
             use_runtime: d
             ocamlrunparam: "v=0,V=1"
 
-          - name: i386
-            config: --enable-stack-allocation=no CC='cc32' AS='as --32' ASPP='gcc -m32 -c' -host i386-linux PARTIALLD='ld -r -melf_i386'
-            os: ubuntu-20.04
-            ocamlparam: ''
-            boot_config: CC='cc32' AS='as --32' ASPP='gcc -m32 -c' -host i386-linux PARTIALLD='ld -r -melf_i386'
-            boot_cachekey: 32bit
-
     env:
       J: "3"
 
@@ -36,11 +29,6 @@ jobs:
       if: matrix.os == 'macos-latest'
       run: HOMEBREW_NO_INSTALL_CLEANUP=TRUE brew install parallel
 
-    - name: Install GCC 32-bit libraries
-      if: matrix.name == 'i386'
-      run: |
-        sudo apt-get install gcc-multilib gfortran-multilib
-
     - name: Checkout the ocaml-jst repo
       uses: actions/checkout@master
       with:
@@ -61,13 +49,6 @@ jobs:
         path: 'ocaml-414'
         ref: '4.14'
 
-    - name: Setup 32-bit C compiler
-      if: matrix.name == 'i386' && steps.cache.outputs.cache-hit != 'true'
-      run: |
-        mkdir -p ocaml-414/_install/bin
-        { echo '#!/bin/sh'; echo 'exec gcc -m32 "$@"'; } > ocaml-414/_install/bin/cc32
-        chmod +x ocaml-414/_install/bin/cc32
-
     - name: Build OCaml 4.14
       if: steps.cache.outputs.cache-hit != 'true'
       working-directory: ocaml-414

HACKING.jst.adoc

@@ -82,3 +82,26 @@ To add a new printer, simply add a line of the form
 
 to `tools/debug_printers.ml`, and then run `make debug_printers` in the `tools`
 directory to regenerate the printing script.
+
+## Benchmarking
+
+A small but relatively comprehensive benchmark is to run our compiler against `typing/typecore.ml`. First we install the 
+opam switch with FP (frame pointers) enabled; adjust the version number as needed:
+
+    $ opam switch create 4.14.1-fp --packages=ocaml-variants.4.14.1+options,ocaml-option-fp --repos=default
+
+Remember to check that the newly installed switch is being used:
+
+    $ opam switch
+    #   switch     compiler                                         description
+        4.14.1     ocaml-base-compiler.4.14.1                       4.14.1
+    ->  4.14.1-fp  ocaml-option-fp.1,ocaml-variants.4.14.1+options  4.14.1-fp
+
+Then build the compiler - the following command will build the compiler using the opam switch, then use the newly-built compiler to build itself.
+
+    $ make -f Makefile.jst compiler
+
+We can now benchmark our compiler against `typecore.ml`. The following `_bootinstall` is built using the opam switch and has FP enabled. 
+
+    $ cd _build/main
+    $ perf stat -r 5 ../_bootinstall/bin/ocamlc.opt -strict-sequence -principal -w +a-4-9-40-41-42-44-45-48-66-70 -warn-error A -bin-annot -safe-string -strict-formats -w -67 -g -bin-annot -I .ocamlcommon.objs/byte -I ../install/runtime_stdlib/lib/ocaml_runtime_stdlib/  -intf-suffix .ml -no-alias-deps -o .ocamlcommon.objs/byte/typecore.cmo -c -impl typecore.ml

asmcomp/afl_instrument.ml

@@ -88,7 +88,7 @@ and instrument = function
      Ccatch (isrec, cases, instrument body, kind)
   | Cexit (ex, args) -> Cexit (ex, List.map instrument args)
   | Cregion e -> Cregion (instrument e)
-  | Ctail e -> Ctail (instrument e)
+  | Cexclave e -> Cexclave (instrument e)
 
   (* these are base cases and have no logging *)
   | Cconst_int _ | Cconst_natint _ | Cconst_float _

asmcomp/cmm.ml

@@ -206,7 +206,7 @@ type expression =
   | Ctrywith of expression * Backend_var.With_provenance.t * expression
       * Debuginfo.t * kind_for_unboxing
   | Cregion of expression
-  | Ctail of expression
+  | Cexclave of expression
 
 type codegen_option =
   | Reduce_code_size
@@ -270,7 +270,7 @@ let iter_shallow_tail f = function
   | Cexit _ | Cop (Craise _, _, _) ->
       true
   | Cregion _
-  | Ctail _
+  | Cexclave _
   | Cconst_int _
   | Cconst_natint _
   | Cconst_float _
@@ -312,7 +312,7 @@ let map_shallow_tail ?kind f = function
   | Cexit _ | Cop (Craise _, _, _) as cmm ->
       cmm
   | Cregion _
-  | Ctail _
+  | Cexclave _
   | Cconst_int _
   | Cconst_natint _
   | Cconst_float _
@@ -325,7 +325,7 @@ let map_shallow_tail ?kind f = function
 let map_tail ?kind f =
   let rec loop = function
     | Cregion _
-    | Ctail _
+    | Cexclave _
     | Cconst_int _
     | Cconst_natint _
     | Cconst_float _
@@ -367,7 +367,7 @@ let iter_shallow f = function
       f e1; f e2
   | Cregion e ->
       f e
-  | Ctail e ->
+  | Cexclave e ->
       f e
   | Cconst_int _
   | Cconst_natint _
@@ -404,8 +404,8 @@ let map_shallow f = function
       Ctrywith (f e1, id, f e2, dbg, value_kind)
   | Cregion e ->
       Cregion (f e)
-  | Ctail e ->
-      Ctail (f e)
+  | Cexclave e ->
+      Cexclave (f e)
   | Cconst_int _
   | Cconst_natint _
   | Cconst_float _

asmcomp/cmm.mli

@@ -210,7 +210,7 @@ type expression =
   | Ctrywith of expression * Backend_var.With_provenance.t * expression
       * Debuginfo.t * kind_for_unboxing
   | Cregion of expression
-  | Ctail of expression
+  | Cexclave of expression
 
 type codegen_option =
   | Reduce_code_size

asmcomp/cmm_helpers.ml

@@ -619,13 +619,11 @@ let rec unbox_float dbg =
           map_tail ~kind:Any
             (function
               | Cop (Capply (_, Rc_close_at_apply), _, _) -> raise Exit
-              | Ctail e -> Ctail (unbox_float dbg e)
               | e -> unbox_float dbg e)
             e
         with
         | e -> Cregion e
         | exception Exit -> Cop (Cload (Double, Immutable), [cmm], dbg))
-      | Ctail e -> Ctail (unbox_float dbg e)
       | cmm -> Cop(Cload (Double, Immutable), [cmm], dbg)
     )
 
@@ -1309,13 +1307,11 @@ let rec unbox_int dbg bi =
           map_tail ~kind:Any
             (function
               | Cop (Capply (_, Rc_close_at_apply), _, _) -> raise Exit
-              | Ctail e -> Ctail (unbox_int dbg bi e)
               | e -> unbox_int dbg bi e)
             e
         with
         | e -> Cregion e
         | exception Exit -> default cmm)
-      | Ctail e -> Ctail (unbox_int dbg bi e)
       | cmm ->
           default cmm
     )
@@ -2018,15 +2014,15 @@ let has_local_allocs e =
   let rec loop = function
     | Cregion e ->
         (* Local allocations within a nested region do not affect this region,
-           except inside a Ctail block *)
+           except inside a Cexclave block *)
         loop_until_tail e
     | Cop (Calloc Alloc_local, _, _)
     | Cop ((Cextcall _ | Capply _), _, _) ->
         raise Exit
     | e ->
         iter_shallow loop e
   and loop_until_tail = function
-    | Ctail e -> loop e
+    | Cexclave e -> loop e
     | Cregion _ -> ()
     | e -> ignore (iter_shallow_tail loop_until_tail e)
   in
@@ -2036,13 +2032,13 @@ let has_local_allocs e =
 
 let remove_region_tail e =
   let rec has_tail = function
-    | Ctail _
+    | Cexclave _
     | Cop(Capply(_, Rc_close_at_apply), _, _) -> raise Exit
     | Cregion _ -> ()
     | e -> ignore (iter_shallow_tail has_tail e)
   in
   let rec remove_tail = function
-    | Ctail e -> e
+    | Cexclave e -> e
     | Cop(Capply(mach, Rc_close_at_apply), args, dbg) ->
        Cop(Capply(mach, Rc_normal), args, dbg)
     | Cregion _ as e -> e

asmcomp/cmm_invariants.ml

@@ -174,7 +174,7 @@ let rec check env (expr : Cmm.expression) =
     check env body;
     check env handler
   | Cregion e -> check env e
-  | Ctail e -> check env e
+  | Cexclave e -> check env e
 
 let run ppf (fundecl : Cmm.fundecl) =
   let env = Env.init () in

asmcomp/cmmgen.ml

@@ -168,11 +168,14 @@ let rec expr_size env = function
      (* Pgenarray is excluded from recursive bindings by the
         check in Translcore.check_recursive_lambda *)
      RHS_nonrec
-  | Uprim (Pduprecord ((Record_regular | Record_inlined _), sz), _, _) ->
+  | Uprim (Pduprecord ((Record_boxed _ | Record_inlined (_, Variant_boxed _)),
+                       sz), _, _) ->
       RHS_block (Lambda.alloc_heap, sz)
-  | Uprim (Pduprecord (Record_unboxed _, _), _, _) ->
+  | Uprim (Pduprecord ((Record_unboxed _
+                       | Record_inlined (_, Variant_unboxed _)),
+                       _), _, _) ->
       assert false
-  | Uprim (Pduprecord (Record_extension _, sz), _, _) ->
+  | Uprim (Pduprecord (Record_inlined (_, Variant_extensible), sz), _, _) ->
       RHS_block (Lambda.alloc_heap, sz + 1)
   | Uprim (Pduprecord (Record_float, sz), _, _) ->
       RHS_floatblock (Lambda.alloc_heap, sz)
@@ -190,7 +193,7 @@ let rec expr_size env = function
       | _ -> assert false)
   | Uregion exp ->
       expr_size env exp
-  | Utail exp ->
+  | Uexclave exp ->
       expr_size env exp
   | _ -> RHS_nonrec
 
@@ -368,7 +371,7 @@ let is_unboxed_number_cmm ~strict cmm =
         | _ ->
             notify No_unboxing
         end
-    | Cregion e | Ctail e ->
+    | Cregion e ->
         aux e
     | l ->
         if not (Cmm.iter_shallow_tail aux l) then
@@ -748,8 +751,8 @@ let rec transl env e =
       Cop(Cload (Word_int, Mutable), [Cconst_int (0, dbg)], dbg)
   | Uregion e ->
       region (transl env e)
-  | Utail e ->
-      Ctail (transl env e)
+  | Uexclave e ->
+      Cexclave (transl env e)
 
 and transl_catch (kind : Cmm.kind_for_unboxing) env nfail ids body handler dbg =
   let ids = List.map (fun (id, kind) -> (id, kind, ref No_result)) ids in

asmcomp/printcmm.ml

@@ -272,8 +272,8 @@ let rec expr ppf = function
              sequence e1 VP.print id sequence e2
   | Cregion e ->
       fprintf ppf "@[<2>(region@ %a)@]" sequence e
-  | Ctail e ->
-      fprintf ppf "@[<2>(tail@ %a)@]" sequence e
+  | Cexclave e ->
+      fprintf ppf "@[<2>(exclave@ %a)@]" sequence e
 
 and sequence ppf = function
   | Csequence(e1, e2) -> fprintf ppf "%a@ %a" sequence e1 sequence e2

asmcomp/selectgen.ml

@@ -388,7 +388,7 @@ method is_simple_expr = function
       | Ccmpf _ -> List.for_all self#is_simple_expr args
       end
   | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _
-  | Ctrywith _ | Cregion _ | Ctail _ -> false
+  | Ctrywith _ | Cregion _ | Cexclave _ -> false
 
 (* Analyses the effects and coeffects of an expression.  This is used across
    a whole list of expressions with a view to determining which expressions
@@ -435,7 +435,7 @@ method effects_of exp =
     in
     EC.join from_op (EC.join_list_map args self#effects_of)
   | Cassign _ | Cswitch _ | Ccatch _ | Cexit _ | Ctrywith _
-  | Cregion _ | Ctail _ ->
+  | Cregion _ | Cexclave _ ->
     EC.arbitrary
 
 (* Says whether an integer constant is a suitable immediate argument for
@@ -974,9 +974,9 @@ method emit_expr_aux (env:environment) exp :
         assert (List.length unclosed <= List.length old_regions);
         Some (rd, unclosed)
      end
-  | Ctail e ->
+  | Cexclave e ->
      begin match env.regions with
-     | [] -> Misc.fatal_error "Selectgen.emit_expr: Ctail but not in tail of a region"
+     | [] -> Misc.fatal_error "Selectgen.emit_expr: Cexclave but not in tail of a region"
      | cl :: rest ->
        self#insert_endregions env [cl];
        self#emit_expr_aux { env with regions = rest } e
@@ -1320,9 +1320,9 @@ method emit_tail (env:environment) exp =
       let reg = self#regs_for typ_int in
       self#insert env (Iop Ibeginregion) [| |] reg;
       self#emit_tail {env with regions = reg::env.regions} e
-  | Ctail e ->
+  | Cexclave e ->
       begin match env.regions with
-      | [] -> Misc.fatal_error "Selectgen.emit_tail: Ctail not inside Cregion"
+      | [] -> Misc.fatal_error "Selectgen.emit_tail: Cexclave not inside Cregion"
       | reg :: regions ->
          self#insert_endregions env [reg];
          self#emit_tail { env with regions } e