Remove target-specific field of Emitenv

Put special cases directly in Emitenv and add comments
explaining which emitters use which features.

asmcomp/amd64/emit.mlp

@@ -828,7 +828,7 @@ let all_functions = ref []
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
-  let env = mk_env fundecl () in
+  let env = mk_env fundecl in
   all_functions := fundecl :: !all_functions;
   emit_named_text_section fundecl.fun_name;
   D.align 16;

asmcomp/arm/emit.mlp

@@ -53,44 +53,6 @@ let emit_reg = function
     {loc = Reg r} -> emit_string (register_name r)
   | _ -> fatal_error "Emit_arm.emit_reg"
 
-(* Pending offset computations : {lbl; dst; src;} --> lbl: .word dst-(src+N) *)
-type offset_computation =
-  { lbl : label;
-    dst : label;
-    src : label;
-  }
-
-(* Pending relative references to the global offset table *)
-type gotrel_literal =
-  { lbl_got : label;
-    lbl_pic : label;
-  }
-
-(* Pending symbol literals *)
-type symbol_literal =
-  {
-    sym : string;
-    lbl : label;
-  }
-
-type pending =
-  {
-    mutable offset_literals : offset_computation list;
-    mutable gotrel_literals : gotrel_literal list;
-    mutable symbol_literals : symbol_literal list;
-    (* Total space (in words) occupied by the pending literals above
-       and [env.float_literals]. *)
-    mutable size_literals : int;
-  }
-
-let mk_pending () =
-  {
-    offset_literals = [];
-    gotrel_literals = [];
-    symbol_literals = [];
-    size_literals = 0;
-  }
-
 let frame_size env =
   let sz =
     env.stack_offset +
@@ -288,41 +250,37 @@ let float_literal env fl =
     x.lbl
   with Not_found ->
     let lbl = new_label() in
-    env.p.size_literals <- env.p.size_literals + 2;
+    env.size_literals <- env.size_literals + 2;
     env.float_literals <- { fl; lbl } :: env.float_literals;
     lbl
 
 (* Label a GOTREL literal *)
 let gotrel_literal env lbl_pic =
-  let p = env.p in
   let lbl_got = new_label() in
-  p.size_literals <- p.size_literals + 1;
-  p.gotrel_literals <- { lbl_got; lbl_pic } :: p.gotrel_literals;
+  env.size_literals <- env.size_literals + 1;
+  env.gotrel_literals <- { lbl_got; lbl_pic } :: env.gotrel_literals;
   lbl_got
 
 (* Label a symbol literal *)
 let symbol_literal env sym =
-  let p = env.p in
   try
-    let sl = List.find (fun x -> String.equal x.sym sym) p.symbol_literals in
+    let sl = List.find (fun x -> String.equal x.sym sym) env.symbol_literals in
     sl.lbl
   with Not_found ->
     let lbl = new_label() in
-    p.size_literals <- p.size_literals + 1;
-    p.symbol_literals <- { sym; lbl } :: p.symbol_literals;
+    env.size_literals <- env.size_literals + 1;
+    env.symbol_literals <- { sym; lbl } :: env.symbol_literals;
     lbl
 
 (* Add an offset computation *)
 let offset_literal env dst src =
-  let p = env.p in
   let lbl = new_label() in
-  p.size_literals <- p.size_literals + 1;
-  p.offset_literals <- { lbl; dst; src; } :: p.offset_literals;
+  env.size_literals <- env.size_literals + 1;
+  env.offset_literals <- { lbl; dst; src; } :: env.offset_literals;
   lbl
 
 (* Emit all pending literals *)
 let emit_literals env =
-  let p = env.p in
   if env.float_literals <> [] then begin
     `	.align	3\n`;
     List.iter
@@ -331,22 +289,22 @@ let emit_literals env =
       env.float_literals;
     env.float_literals <- []
   end;
-  if p.symbol_literals <> [] then begin
+  if env.symbol_literals <> [] then begin
     let offset = if !thumb then 4 else 8 in
     let suffix = if !Clflags.pic_code then "(GOT)" else "" in
     `	.align	2\n`;
     List.iter
       (fun { lbl_got; lbl_pic } ->
         `{emit_label lbl_pic}:	.word	_GLOBAL_OFFSET_TABLE_-({emit_label lbl_got}+{emit_int offset})\n`)
-      p.gotrel_literals;
+      env.gotrel_literals;
     List.iter
       (fun { sym; lbl } ->
         `{emit_label lbl}:	.word	{emit_symbol sym}{emit_string suffix}\n`)
-      p.symbol_literals;
-    p.gotrel_literals <- [];
-    p.symbol_literals <- []
+      env.symbol_literals;
+    env.gotrel_literals <- [];
+    env.symbol_literals <- []
   end;
-  if p.offset_literals <> [] then begin
+  if env.offset_literals <> [] then begin
     (* Additions using the pc register read a value 4 or 8 bytes greater than
        the instruction's address, depending on the Thumb setting.  However in
        Thumb mode we must follow interworking conventions and ensure that the
@@ -357,10 +315,10 @@ let emit_literals env =
     List.iter
       (fun { lbl; dst; src; } ->
          `{emit_label lbl}:	.word	{emit_label dst}-({emit_label src}+{emit_int offset})\n`)
-      p.offset_literals;
-    p.offset_literals <- []
+      env.offset_literals;
+    env.offset_literals <- []
   end;
-  p.size_literals <- 0
+  env.size_literals <- 0
 
 (* Emit code to load the address of a symbol *)
 
@@ -929,12 +887,12 @@ let rec emit_all env ninstr fallthrough i =
     let limit = (if !fpu >= VFPv2 && env.float_literals <> []
                  then 127
                  else 511) in
-    let limit = limit - env.p.size_literals - max_instruction_size i in
+    let limit = limit - env.size_literals - max_instruction_size i in
     let ninstr' =
       if ninstr >= limit - 64 && not fallthrough then begin
         emit_literals env;
         0
-      end else if env.p.size_literals != 0 && ninstr >= limit then begin
+      end else if env.size_literals != 0 && ninstr >= limit then begin
         let lbl = new_label() in
         `	b	{emit_label lbl}\n`;
         emit_literals env;
@@ -949,7 +907,7 @@ let rec emit_all env ninstr fallthrough i =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
-  let env = mk_env fundecl (mk_pending()) in
+  let env = mk_env fundecl in
   emit_named_text_section fundecl.fun_name;
   `	.align	2\n`;
   `	.globl	{emit_symbol fundecl.fun_name}\n`;

asmcomp/arm64/emit.mlp

@@ -963,7 +963,7 @@ let rec emit_all env i =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
-  let env = mk_env fundecl () in
+  let env = mk_env fundecl in
   emit_named_text_section fundecl.fun_name;
   `	.align	3\n`;
   `	.globl	{emit_symbol fundecl.fun_name}\n`;

asmcomp/emitaux.ml

@@ -386,14 +386,20 @@ let report_error ppf = function
   | Stack_frame_too_large n ->
       Format.fprintf ppf "stack frame too large (%d bytes)" n
 
-let mk_env f (p:'a) : 'a Emitenv.per_function_env =
+let mk_env f : Emitenv.per_function_env =
   {
     f;
     stack_offset = 0;
     call_gc_sites = [];
     bound_error_sites = [];
     bound_error_call = None;
+    call_gc_label = 0;
+    jumptables_lbl = None;
+    jumptables = [];
     float_literals = [];
     int_literals = [];
-    p;
+    offset_literals = [];
+    gotrel_literals = [];
+    symbol_literals = [];
+    size_literals = 0;
   }

asmcomp/emitaux.mli

@@ -85,4 +85,4 @@ type error =
 exception Error of error
 val report_error: Format.formatter -> error -> unit
 
-val mk_env : Linear.fundecl -> 'a -> 'a Emitenv.per_function_env
+val mk_env : Linear.fundecl -> Emitenv.per_function_env

asmcomp/emitenv.mli

@@ -23,9 +23,8 @@ type gc_call =
   }
 
 (* Record calls to caml_ml_array_bound_error.
-   In -g mode, or when using Spacetime profiling, we maintain one call to
-   caml_ml_array_bound_error per bound check site.  Without -g, we can share
-   a single call. *)
+   In -g mode, we maintain one call to caml_ml_array_bound_error
+   per bound check site.  Without -g, we can share a single call. *)
 
 type bound_error_call =
   { bd_lbl: label;                      (* Entry label *)
@@ -46,14 +45,49 @@ type int_literal =
     n_lbl : label;
   }
 
+(* Pending offset computations : {lbl; dst; src;} --> lbl: .word dst-(src+N) *)
+type offset_computation =
+  { lbl : label;
+    dst : label;
+    src : label;
+  }
+
+(* Pending relative references to the global offset table *)
+type gotrel_literal =
+  { lbl_got : label;
+    lbl_pic : label;
+  }
+
+(* Pending symbol literals *)
+type symbol_literal =
+  {
+    sym : string;
+    lbl : label;
+  }
+
 (* Environment for emitting a function *)
-type 'a per_function_env = {
+type per_function_env = {
   f : Linear.fundecl;
   mutable stack_offset : int;
   mutable call_gc_sites : gc_call list;
   mutable bound_error_sites : bound_error_call list;
   mutable bound_error_call : label option;
+  mutable call_gc_label : label;                       (* used only in power *)
+
+  (* record jump tables (for PPC64).  In order to reduce the size of the TOC,
+     we concatenate all jumptables and emit them at the end of the function. *)
+  mutable jumptables_lbl : label option;                (* use only in power *)
+  mutable jumptables : label list; (* in reverse order *)
+
+  (* pending literals *)
   mutable float_literals : float_literal list;
-  mutable int_literals : int_literal list;
-  p : 'a;
+  mutable int_literals : int_literal list;             (* used only in s390x *)
+  mutable offset_literals : offset_computation list;     (* used only in arm *)
+  mutable gotrel_literals : gotrel_literal list;         (* used only in arm *)
+  mutable symbol_literals : symbol_literal list;         (* used only in arm *)
+  (* [size_literals] is the total space (in words) occupied
+     by pending literals. *)
+  mutable size_literals : int;                           (* used only in arm *)
+
+
 }

asmcomp/i386/emit.mlp

@@ -888,7 +888,7 @@ let rec emit_all env fallthrough i =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
-  let env = mk_env fundecl () in
+  let env = mk_env fundecl in
   emit_named_text_section fundecl.fun_name;
   add_def_symbol fundecl.fun_name;
   D.align (if system = S_win32 then 4 else 16);

asmcomp/power/emit.mlp

@@ -33,23 +33,6 @@ let reserved_stack_space =
   | ELF64v1 -> 48
   | ELF64v2 -> 32
 
-(* Record jump tables (for PPC64).  In order to reduce the size of the TOC,
-   we concatenate all jumptables and emit them at the end of the function. *)
-
-type pending = {
-  (* Label of glue code for calling the GC. *)
-  mutable call_gc_label : int;
-  mutable jumptables_lbl : label option;
-  mutable jumptables : label list; (* in reverse order *)
-}
-
-let mk_pending () =
-  {
-    call_gc_label = 0;
-    jumptables_lbl = None;
-    jumptables = [];
-  }
-
 (* Layout of the stack.  The stack is kept 16-aligned. *)
 
 let initial_stack_offset f =
@@ -523,19 +506,19 @@ end)
 (* Assembly code for inlined allocation *)
 
 let emit_alloc env i bytes dbginfo far =
-  if env.p.call_gc_label = 0 then env.p.call_gc_label <- new_label ();
+  if env.call_gc_label = 0 then env.call_gc_label <- new_label ();
   let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
   `	{emit_string lg}	0, {emit_int offset}(30)\n`;
   `	addi    31, 31, {emit_int(-bytes)}\n`;
   `	{emit_string cmplg}	31, 0\n`;
   if not far then begin
-    `	bltl	{emit_label env.p.call_gc_label}\n`;
+    `	bltl	{emit_label env.call_gc_label}\n`;
     record_frame env i.live (Dbg_alloc dbginfo);
     `	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
   end else begin
     let lbl = new_label() in
     `	bge	{emit_label lbl}\n`;
-    `	bl	{emit_label env.p.call_gc_label}\n`;
+    `	bl	{emit_label env.call_gc_label}\n`;
     record_frame env i.live (Dbg_alloc dbginfo);
     `{emit_label lbl}:	addi	{emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
   end
@@ -928,14 +911,14 @@ let emit_instr env i =
     | Lswitch jumptbl ->
         let lbl = new_label() in
         if ppc64 then begin
-          let jumptables_lbl = match env.p.jumptables_lbl with
+          let jumptables_lbl = match env.jumptables_lbl with
             | None ->
-              env.p.jumptables_lbl <- Some lbl;
-              assert (List.length env.p.jumptables = 0);
+              env.jumptables_lbl <- Some lbl;
+              assert (List.length env.jumptables = 0);
               lbl
             | Some l-> l
           in
-          let start = List.length env.p.jumptables in
+          let start = List.length env.jumptables in
           let (start_lo, start_hi) = low_high_s start in
           emit_tocload emit_gpr 11 (TocLabel jumptables_lbl);
           `	addi	12, {emit_reg i.arg.(0)}, {emit_int start_lo}\n`;
@@ -952,7 +935,7 @@ let emit_instr env i =
         `	mtctr	0\n`;
         `	bctr\n`;
         if ppc64 then begin
-          env.p.jumptables <- List.rev_append (Array.to_list jumptbl) env.p.jumptables
+          env.jumptables <- List.rev_append (Array.to_list jumptbl) env.jumptables
         end else begin
           emit_string rodata_space;
           `{emit_label lbl}:`;
@@ -1026,7 +1009,7 @@ let rec emit_all env i =
 (* Emission of a function declaration *)
 
 let fundecl fundecl =
-  let env = mk_env fundecl (mk_pending ()) in
+  let env = mk_env fundecl in
   begin match abi with
   | ELF32 ->
     emit_string code_space;
@@ -1062,8 +1045,8 @@ let fundecl fundecl =
   BR.relax fundecl ~max_out_of_line_code_offset:0;
   emit_all env fundecl.fun_body;
   (* Emit the glue code to call the GC *)
-  if env.p.call_gc_label > 0 then begin
-    `{emit_label env.p.call_gc_label}:\n`;
+  if env.call_gc_label > 0 then begin
+    `{emit_label env.call_gc_label}:\n`;
     match abi with
     | ELF32 ->
       `	b	{emit_symbol "caml_call_gc"}\n`
@@ -1100,7 +1083,7 @@ let fundecl fundecl =
       env.float_literals
   end;
   (* Emit the jump tables *)
-  match env.p.jumptables, env.p.jumptables_lbl with
+  match env.jumptables, env.jumptables_lbl with
   | _ :: _, None | [], Some _ -> assert false (* Sanity check *)
   | [], None -> ()
   | _ :: _, Some j ->
@@ -1110,7 +1093,7 @@ let fundecl fundecl =
     List.iter
       (fun  lbl ->
          `	.long	{emit_label lbl} - {emit_label j}\n`)
-      (List.rev env.p.jumptables)
+      (List.rev env.jumptables)
 
 (* Emission of data *)